Question

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

任何帮助都非常适合!!

示例：

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

在我的代码下面有点修改，除了不显示第四列之外它都有效。实际上会添加更多的列，所以很高兴看到我必须调整代码以便灵活使用Columns。任何的想法？提前致谢

Textfile（只有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

End Sub

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

Excel VBA导入具有可变列宽的TEXT文件

1 个答案: