固定長のテキストファイルを区切り文字に変換するためのExcelマクロ

Question

これは私が使用しているコードであり、1行だけです。テキストファイルのすべての行に適用するには一般的にする必要があります私はテキストファイルの合計150行を持っています。レコードの終わりとして次の行を作成している間、私はそれをループすることができます。

コード：

Public Sub Convert_TxtFile() 
Dim myStr As String 
    myStr = FileText("C:\Users\BS255028\Desktop\Book2.txt") 
    Cells(1, 1) = Mid(myStr, 1, 4) 
    Cells(1, 2) = Mid(myStr, 5, 3) 
    Cells(1, 3) = Mid(myStr, 8, 8) 
    Cells(1, 4) = Mid(myStr, 16, 2) 
    End Sub 

    Function FileText(ByVal filename As String) As String 

    Dim nFileNum As Integer 

    If Len(Dir$(filename)) = 0 Then 
     Err.Raise 53 
    End If 

    nFileNum = FreeFile 
    Open filename$ For Binary As #nFileNum 
    FileText = Space$(LOF(nFileNum)) 
    Get #nFileNum, , FileText 
    Close #nFileNum 

    End Function 

Answer 1

テキストファイルをインポートするマクロを記録するだけで済みます。固定幅を使用すると、テキストを希望の幅に基づいて列に分割できます。

With ActiveSheet.QueryTables.Add(Connection:= _ 
    "TEXT;C:\Users\BS255028\Desktop\Book2.txt", _ 
    Destination:=Range("$A$1")) 
    .Name = "adam_styborskis_pauper_cube" 
    .FieldNames = True 
    .RowNumbers = False 
    .FillAdjacentFormulas = False 
    .PreserveFormatting = True 
    .RefreshOnFileOpen = False 
    .RefreshStyle = xlInsertDeleteCells 
    .SavePassword = False 
    .SaveData = True 
    .AdjustColumnWidth = True 
    .RefreshPeriod = 0 
    .TextFilePromptOnRefresh = False 
    .TextFilePlatform = 437 
    .TextFileStartRow = 1 
    .TextFileParseType = xlFixedWidth 
    .TextFileTextQualifier = xlTextQualifierDoubleQuote 
    .TextFileConsecutiveDelimiter = False 
    .TextFileTabDelimiter = True 
    .TextFileSemicolonDelimiter = False 
    .TextFileCommaDelimiter = False 
    .TextFileSpaceDelimiter = False 
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1) 
    .TextFileFixedColumnWidths = Array(4, 3, 8, 2) 
    .TextFileTrailingMinusNumbers = True 
    .Refresh BackgroundQuery:=False 
End With 

Answer 2

方法がわからないFileText作品が、それはExcelで150行にテキストを置く場合、あなただけのループを追加することができます。

Public Sub Convert_TxtFile() 
Dim myStr As String 
Dim i as Long 

myStr = FileText("C:\Users\BS255028\Desktop\Book2.txt") 
For i = 1 to 150 
    Cells(i, 1) = Mid(myStr, 1, 4) 
    Cells(i, 2) = Mid(myStr, 5, 3) 
    Cells(i, 3) = Mid(myStr, 8, 8) 
    Cells(i, 4) = Mid(myStr, 16, 2) 
Next i 
End Sub 

Answer 3

未テスト：

Public Sub Convert_TxtFile() 
    Dim myStr As String, s, arr, i As Long 
    myStr = FileText("C:\Users\BS255028\Desktop\Book2.txt") 
    arr = Split(myStr, vbCrLf) 
    i = 1 
    for each s in arr 
     Cells(i, 1).Resize(1, 4) = Array(Mid(myStr, 1, 4), Mid(myStr, 5, 3), _ 
             Mid(myStr, 8, 8), Mid(myStr, 16, 2)) 
     i = i + 1 
    next 

End Sub