0

VBAを介してFixedwithFiles（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の場合は2番目の列（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

私のコードの下では少し変更されており、4番目の列が表示されないことを除いて機能します。実際にはさらに多くの列が追加されるので、列を柔軟にするためにコードを微調整する必要がある場所を確認するのは素晴らしいことです。何か案が？前もって感謝します

テキストファイル（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

サブ終了

4

1 に答える 1

0

未テスト:

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
于 2012-08-07T06:22:32.620 に答える