如何將不帶分隔符的.txt文件轉換爲Excel

Question

我在.txt文件中獲得了多個不以任何分隔符分隔的數據。它只是一串字符串。到目前爲止，我做到了這一點，但我現在卡住了。在這之後我應該在哪裏繼續？以下是我迄今爲止所做的示例。有人能澄清我下一步該做什麼嗎？

Dim objFSO 
Dim TextFile 
Dim TextRead 
Dim Line, Line1, Line2, Line3 
Dim Count 

Const ForReading = 1 'Constant declared so that can be used throughout the script 

'Name of the text file that need to be convert 
TextFile = "C:\Documents and Settings\Administrator\Desktop\2_12_2015\HRILOANDIC20170601.txt" 

'Create File system object 
set objFSO = CreateObject("Scripting.FileSystemObject") 

'set the text file to read and open it in read-only mode 
set TextRead = objFSO.OpenTextFile(TextFile,ForReading) 

Do Until TextRead.AtEndOfStream 
    Line = TextRead.ReadLine 

    If Left(Line, 1) = "H" Then 
     HeaderRecordType = Mid(Line, 1, 1) 
     HeaderSequenceNo = Mid(Line, 2, 9) 
     HeaderContractNo = Mid(Line, 11, 19) 
     HeaderCreationBy = Mid(Line, 30, 1) 
     HeaderTransactionDate = Mid(Line, 31, 8) 
     HeaderTotalRecord = Mid(Line, 39, 9) 
     HeaderTotalAmount = Mid(Line, 48, 17) 
     HeaderSource = Mid(Line, 65, 2) 
     HeaderFiller = Mid(Line, 67, 334) 

    ElseIf Left(Line, 1) = "D" Then 
     DetailRecordType = Mid(Line, 1, 1) 
     DetailSequenceNo = Mid(Line, 2, 9) 
     DetailContractNo = Mid(Line, 11, 19) 
     DetailPaymentType = Mid(Line, 30, 10) 
     DetailSettlementType = Mid(Line, 40, 1) 
     DetailEffectiveDate = Mid(Line, 41, 8) 
     DetailCreditAccountNo = Mid(Line, 49, 19) 
     DetailCreditAccountType = Mid(Line, 68, 1) 
     DetailCrTransactionAmount = Mid(Line, 69, 17) 
     DetailLoanType = Mid(Line, 86, 10) 
     DetailBankEmployeeID = Mid(Line, 96, 40) 
     DetailIDNumber = Mid(Line, 136, 40) 
     DetailIDTypeCode = Mid(Line, 176, 3) 
     DetailBankEmployeeName = Mid(Line, 179, 200) 
     DetailHRISProcessStatus = Mid(Line, 379, 1) 
     DetailCIFnumber = Mid(Line, 380, 19) 
     DetailAccountBranch = Mid(Line, 399, 5) 

    ElseIf Left(Line, 1) = "T" Then 
     TrailerRecordType = Mid(Line, 1, 1) 
     TrailerSequenceNo = Mid(Line, 2, 9) 
     TrailerTotalRecord = Mid(Line, 30, 9) 
     TrailerTotalAmount = Mid(Line, 39, 17) 
     TrailerFiller = Mid(Line, 56, 345) 
    Else 
     'Error Handling 
    End If 

Loop 


ExcelFilePath = "C:\Documents and Settings\Administrator\Desktop\2_12_2015\Output.xlsx" 

'Open the spreadsheet using the excel application object 
Set objExcel = CreateObject("Excel.Application") 
'ExcelObject.WorkBooks.Open ExcelObject 

Set SheetObject = ExcelObject.ActiveWorkbook.Worksheets(1) 

'Modify data in a cell (in this case we are adding data to c2) 
'First value in the brackets = Column number 
'2nd value = Cell number 
SheetObject.Cells(3, 2).Value = "Test" 

'Save and quit 
ExcelObject.ActiveWorkbook.Save 
ExcelObject.ActiveWorkbook.Close 
ExcelObject.Application.Quit 

objExcel.Visible = True 
objExcel.Workbooks.Add 

intRow = 2 

objExcel.Cells(1, 1).Value="?" 'Name of a column 

Answer 1

1. 打開工作表。

2. 將數據寫入工作表而不是像存儲一樣將數據循環。

3. 保存並關閉

這樣的事情。

Dim objFSO 
Dim TextFile 
Dim TextRead 
Dim Line, Line1, Line2, Line3 
Dim Count 

Const ForReading = 1 'Constant declared so that can be used throughout the script 

'Name of the text file that need to be convert 
TextFile = "C:\Documents and Settings\Administrator\Desktop\2_12_2015\HRILOANDIC20170601.txt" 

'Create File system object 
set objFSO = CreateObject("Scripting.FileSystemObject") 

'set the text file to read and open it in read-only mode 
set TextRead = objFSO.OpenTextFile(TextFile,ForReading) 

'Open the spreadsheet using the excel application object 
ExcelFilePath = "C:\Documents and Settings\Administrator\Desktop\2_12_2015\Output.xlsx" 
Set objExcel = CreateObject("Excel.Application") 
Set SheetObject = ExcelObject.ActiveWorkbook.Worksheets(1) 

'Change from storing the data in the below variables to writing them to the worksheet. 

'Create yourself a counter for the worksheet row. 
Dim lRow as long 
lRow = 1 

Do Until TextRead.AtEndOfStream 
    Line = TextRead.ReadLine 

    If Left(Line, 1) = "H" Then 
     SheetObject.Range("A" & lRow).Value = Mid(Line, 1, 1) 
     SheetObject.Range("B" & lRow).Value = Mid(Line, 2, 9) 
     SheetObject.Range("C" & lRow).Value = Mid(Line, 11, 19) 
     SheetObject.Range("D" & lRow).Value = Mid(Line, 30, 1) 
     SheetObject.Range("E" & lRow).Value = Mid(Line, 31, 8) 
     SheetObject.Range("F" & lRow).Value = Mid(Line, 39, 9) 
     SheetObject.Range("G" & lRow).Value = Mid(Line, 48, 17) 
     SheetObject.Range("H" & lRow).Value = Mid(Line, 65, 2) 
     SheetObject.Range("I" & lRow).Value = Mid(Line, 67, 334) 

    ElseIf Left(Line, 1) = "D" Then 
     SheetObject.Range("A" & lRow).Value = Mid(Line, 1, 1) 
     SheetObject.Range("B" & lRow).Value = Mid(Line, 2, 9) 
     SheetObject.Range("C" & lRow).Value = Mid(Line, 11, 19) 
     SheetObject.Range("D" & lRow).Value = Mid(Line, 30, 10) 
     SheetObject.Range("E" & lRow).Value = Mid(Line, 40, 1) 
     SheetObject.Range("F" & lRow).Value = Mid(Line, 41, 8) 
     SheetObject.Range("G" & lRow).Value = Mid(Line, 49, 19) 
     SheetObject.Range("H" & lRow).Value = Mid(Line, 68, 1) 
     SheetObject.Range("I" & lRow).Value = Mid(Line, 69, 17) 
     SheetObject.Range("J" & lRow).Value = Mid(Line, 86, 10) 
     SheetObject.Range("K" & lRow).Value = Mid(Line, 96, 40) 
     SheetObject.Range("L" & lRow).Value = Mid(Line, 136, 40) 
     SheetObject.Range("M" & lRow).Value = Mid(Line, 176, 3) 
     SheetObject.Range("N" & lRow).Value = Mid(Line, 179, 200) 
     SheetObject.Range("O" & lRow).Value = Mid(Line, 379, 1) 
     SheetObject.Range("P" & lRow).Value = Mid(Line, 380, 19) 
     SheetObject.Range("Q" & lRow).Value = Mid(Line, 399, 5) 

    ElseIf Left(Line, 1) = "T" Then 
     SheetObject.Range("A" & lRow).Value = Mid(Line, 1, 1) 
     SheetObject.Range("B" & lRow).Value = Mid(Line, 2, 9) 
     SheetObject.Range("C" & lRow).Value = Mid(Line, 30, 9) 
     SheetObject.Range("D" & lRow).Value = Mid(Line, 39, 17) 
     SheetObject.Range("E" & lRow).Value = Mid(Line, 56, 345) 
    Else 
     'Error Handling 
    End If 

    ' ************************ Don't overlook that i added this! ********** 
    'Increment the counter 
    lRow = lRow + 1 

Loop 

'Then save and quit. 

'Save and quit 
ExcelObject.ActiveWorkbook.Save 
ExcelObject.ActiveWorkbook.Close 
ExcelObject.Application.Quit 

Answer 2

我修改了您的代碼以直接寫入Excel工作簿。我沒有完成它，但給了你足夠的自己修改剩下的。我也對你在哪裏有一些語法和一般的理解錯誤發表了評論。根據需要進行任何列和行分配調整。

Dim objFSO 
Dim TextFile 
Dim TextRead 
Dim Line, Line1, Line2, Line3 
Dim Count 

'Open the spreadsheet using the excel application object 
ExcelFilePath = "C:\Documents and Settings\Administrator\Desktop\2_12_2015\Output.xlsx" 

Set objExcel = CreateObject("Excel.Application") 
Set objWB = objExcel.Workbooks.Open(ExcelFilePath) ' have to open workbook 
Set SheetObject = objWB.Worksheets(1) 'worksheets are a member of workbooks, not the Excel Application 

'open the text file 
Const ForReading = 1 'Constant declared so that can be used throughout the script 

'Name of the text file that need to be convert 
TextFile = "C:\Documents and Settings\Administrator\Desktop\2_12_2015\HRILOANDIC20170601.txt" 

'Create File system object 
set objFSO = CreateObject("Scripting.FileSystemObject") 

'set the text file to read and open it in read-only mode 
set TextRead = objFSO.OpenTextFile(TextFile,ForReading) 

i = 1 'to set row number for Excel paste 

Do Until TextRead.AtEndOfStream 

    Line = TextRead.ReadLine 

    If Left(Line, 1) = "H" Then 
     SheetObject.Cells(i, 1).Value = Mid(Line, 1, 1) 'HeaderRecordType to column A 
     SheetObject.Cells(i, 2).Value = Mid(Line, 2, 9) 'ValueHeaderSequenceNo to column b 
     SheetObject.Cells(i, 3).Value = Mid(Line, 11, 19) 'HeaderContractNo to column C 

     '... keep going with your code 

    Else 
     'Error Handling 
    End If 

    i = i + 1 'to move down the Excel row to paste for each line in the text file 
Loop 

'Save and quit 
objWB.Save 
objWB.Close 
objExcel.Quit