Excel VBA导入可变列宽度的TXT文件

Question

我通过VBA将固定文件（TXT）导入到Excel中有一个难题。问题并不是真正将数据导入Excel（下面的代码），而是根据TXT文件的列内容更改列宽。

任何帮助是非常appriciated！

实施例：

TXT文件的内容是：

FirstC  SecondC   ThirdC 
A    111122223333  444455556666 
B    111122223333  444455556666 
A    111122223333  444455556666 
A    111122223333  444455556666 
B    111122223333  444455556666 

取决于第一列（FirstC）在Excel中导入列的宽度应改变的内容，即用于A中的列第二列（SecondC）的宽度应为8位数字，并在B的情况下，它应该是10个位数

导入代码（不是亲，很抱歉，如果代码是有点杂乱）：

Sub Button1_Click() 

Dim vPath As Variant 

vPath = Application.GetOpenFilename("TextFiles (*.txt), *.txt", , "TEST TEXT IMPORTER:") 
If vPath = False Then Exit Sub 
Filename = vPath 
Debug.Print vPath 

Worksheets("IMPORT").UsedRange.ClearContents 


With Sheets("IMPORT").QueryTables.Add(Connection:="TEXT;" & CStr(vPath), Destination:=Sheets("IMPORT").Range("A2")) 
     .FieldNames = True 
     .RowNumbers = False 
     .FillAdjacentFormulas = False 
     .PreserveFormatting = True 
     .RefreshOnFileOpen = False 
     .RefreshStyle = xlInsertDeleteCells 
     .SavePassword = False 
     .SaveData = True 
     .AdjustColumnWidth = True 
     .RefreshPeriod = 0 
     .TextFilePromptOnRefresh = False 
     .TextFilePlatform = xlWindows 
     .TextFileStartRow = 1 
     .TextFileParseType = xlFixedWidth 
     .TextFileTextQualifier = xlTextQualifierDoubleQuote 
     .TextFileConsecutiveDelimiter = False 
     .TextFileTabDelimiter = False 
     .TextFileSemicolonDelimiter = False 
     .TextFileCommaDelimiter = False 
     .TextFileSpaceDelimiter = False 
     .TextFileColumnDataTypes = Array(2, 2, 2) 
     .TextFileFixedColumnWidths = Array(14, 18, 12) 
     .TextFileFixedColumnWidths = Array(14, 18, 12) '<-- That’s where I need to be flexible 
     .TextFileTrailingMinusNumbers = True 
     .Refresh BackgroundQuery:=False 

    End With 


End Sub 

---

我下面的代码有点改装和它的作品，只是不显示第四列。 实际上会添加更多的列，所以很高兴看到我必须调整代码以便灵活使用列。任何想法？在此先感谢

文本文件（只显示2行，将更多的未来）是这样的：

0000000002666980001F2002 
0000000002666980002G1020709500430120101L05200000000000000000000 

---

编码：

Sub Button1_Click() 


    Const fPath As String = "H:\MyDocs\xxxxx\TestFiles6.txt" 
    Const fsoForReading = 1 
    Const F1_LEN As Integer = 15 'Reference Number 
    Const F2_LEN As Integer = 4  'Cosectuive Number 
    Const F3_LEN As Integer = 1  'Record Type 
    Const F4_Len As Integer = 4  'Company Number 

    Dim objFSO As Object 
    Dim objTextStream As Object 
    Dim start As Integer 
    Dim fLen As Integer 
    Dim rw As Long 

    Set objFSO = CreateObject("scripting.filesystemobject") 
    Set objTextStream = objFSO.OpenTextFile(fPath, fsoForReading) 
    rw = 2 

    Do Until objTextStream.AtEndOfStream 
     txt = objTextStream.Readline 


     f1 = Trim(Left(txt, F1_LEN)) 
    '------------------------------------------------------------------------------------------------------------ 
     start = F1_LEN + 1 
     f2 = Trim(Mid(txt, start, F2_LEN)) 
    '------------------------------------------------------------------------------------------------------------ 
     start = F1_LEN + F2_LEN + 1 
     f3 = Trim(Mid(txt, start, F3_LEN)) 

     If f3 = "F" Then 
      fLen = 4 
     ElseIf f3 = "G" Then 
      fLen = 50 
     Else 

     End If 

     Debug.Print start 
    '------------------------------------------------------------------------------------------------------------ 
     start = start + 1 
     f4 = Trim(Mid(txt, start, fLen)) 
     Debug.Print f4 
    '------------------------------------------------------------------------------------------------------------ 
     ThisWorkbook.Sheets("data").Cells(rw, 1).Resize(1, 3).Value = Array(f1, f2, f3, f4) 
     rw = rw + 1 
    Loop 

    objTextStream.Close 

末次

Answer 1

未测试：

Sub Tester() 

    Const fPath As String = "C:\SomeFile.txt" 
    Const fsoForReading = 1 
    Const F1_LEN As Integer = 14 
    Const F2_LEN_A As Integer = 8 
    Const F2_LEN_B As Integer = 10 
    Const F3_LEN As Integer = 14 

    Dim objFSO As Object, objTextStream As Object, txt, f1, f2, f3 
    Dim start As Integer, fLen As Integer 
    Dim rw As Long 

    Set objFSO = CreateObject("scripting.filesystemobject") 
    Set objTextStream = objFSO.OpenTextFile(fPath, fsoForReading) 
    rw = 2 

    Do Until objTextStream.AtEndOfStream 
     txt = objTextStream.Readline 


     f1 = Trim(Left(txt, F1_LEN)) 
     start = F1_LEN + 1 

     If f1 = "A" Then 
      fLen = 8 
     ElseIf f1 = "B" Then 
      fLen = 10 
     Else 
      'what if? 
     End If 

     f2 = Trim(Mid(txt, start, fLen)) 
     start = start + fLen + 1 
     f3 = Trim(Mid(txt, start, F3_LEN)) 

     With ThisWorkbook.Sheets("data").Cells(rw, 1).Resize(1, 3) 
      .NumberFormat = "@" 'format cells as text 
      .Value = Array(f1, f2, f3) 
      'alternatively..... 
      '.cells(1).Value = f1 
      '.cells(3).Value = f3 
     End With 
     rw = rw + 1 
    Loop 

    objTextStream.Close 
End Sub