vba - 到 Excel 的文本文件涉及一张表中的多个表

Question

我被分配创建一个转换器来将文本文件转换为 Excel 电子表格。

我设法转换它们，现在我需要为每个表添加标题。意思是，对于每个 If..Else Do 中的声明假设有他们的头衔。

相反，我只是复制了它们。我尝试了很多东西，但最终都失败了。我现在该怎么办？

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

'Open the spreadsheet using the excel application object
ExcelFilePath = "C:\Users\MOHDSABRY\Desktop\Converter\taskCon\Output.xlsx"

Set objExcel = CreateObject("Excel.Application")'Creating excel object
Set objWB = objExcel.Workbooks.Open(ExcelFilePath) 'Creating workbook object
Set SheetObject = objWB.Worksheets("Sheet1") 'worksheets are a member of workbooks, not the Excel Application (Creating sheet object)

'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:\Users\MOHDSABRY\Desktop\Converter\taskCon\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

SheetObject.Columns(1).NumberFormat = "@"
SheetObject.Columns(2).NumberFormat = "@"
SheetObject.Columns(3).NumberFormat = "@"
SheetObject.Columns(4).NumberFormat = "@"
SheetObject.Columns(5).NumberFormat = "@"
SheetObject.Columns(6).NumberFormat = "@"
SheetObject.Columns(7).NumberFormat = "@"
SheetObject.Columns(8).NumberFormat = "@"
SheetObject.Columns(9).NumberFormat = "@"
SheetObject.Columns(10).NumberFormat = "@"
SheetObject.Columns(11).NumberFormat = "@"
SheetObject.Columns(12).NumberFormat = "@"
SheetObject.Columns(13).NumberFormat = "@"
SheetObject.Columns(14).NumberFormat = "@"
SheetObject.Columns(15).NumberFormat = "@"

Do Until TextRead.AtEndOfStream
    Line = TextRead.ReadLine

    If Left(Line, 1) = "H" Then
        SheetObject.Cells(i, 1).Value = Mid(Line, 1, 1)
        SheetObject.Cells(i, 2).Value = Mid(Line, 2, 9)
        SheetObject.Cells(i, 3).Value = Mid(Line, 11, 19)
        SheetObject.Cells(i, 4).Value = Mid(Line, 30, 1)
        SheetObject.Cells(i, 5).Value = Mid(Line, 31, 8)
        SheetObject.Cells(i, 6).Value = Mid(Line, 39, 9)
        SheetObject.Cells(i, 7).Value = Mid(Line, 48, 17)
        SheetObject.Cells(i, 8).Value = Mid(Line, 65, 2)
        SheetObject.Cells(i, 9).Value = Mid(Line, 67, 334)
    ElseIf Left(Line, 1) = "D" 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
        SheetObject.Cells(i, 4).Value = Mid(Line, 30, 10)
        SheetObject.Cells(i, 5).Value = Mid(Line, 40, 1)
        SheetObject.Cells(i, 6).Value = Mid(Line, 49, 19)
        SheetObject.Cells(i, 7).Value = Mid(Line, 68, 1)
        SheetObject.Cells(i, 8).Value = Mid(Line, 69, 17)
        SheetObject.Cells(i, 9).Value = Mid(Line, 96, 40)
        SheetObject.Cells(i, 10).Value = Mid(Line, 136, 40)
        SheetObject.Cells(i,11).Value = Mid(Line, 176, 3)
        SheetObject.Cells(i, 12).Value = Mid(Line, 179, 200)
        SheetObject.Cells(i, 13).Value = Mid(Line, 379, 1)
        SheetObject.Cells(i, 14).Value = Mid(Line, 380, 19)
        SheetObject.Cells(i, 15).Value = Mid(Line, 399, 5)
    ElseIf Left(Line, 1) = "T" Then
        SheetObject.Cells(i, 1).Value = Mid(Line, 1, 1)
        SheetObject.Cells(i, 2).Value = Mid(Line, 2, 9)
        SheetObject.Cells(i, 3).Value = Mid(Line, 30, 9)
        SheetObject.Cells(i, 4).Value = Mid(Line, 39, 17)
        SheetObject.Cells(i, 5).Value = Mid(Line, 65, 2)
        SheetObject.Cells(i, 6).Value = Mid(Line, 56, 354)
    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

下面的示例代码显示了我如何尝试为每个 If..Else 添加标题但失败了。

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

'Open the spreadsheet using the excel application object
ExcelFilePath = "C:\Users\MOHDSABRY\Desktop\Converter\taskCon\Output.xlsx"

Set objExcel = CreateObject("Excel.Application")'Creating excel object
Set objWB = objExcel.Workbooks.Open(ExcelFilePath) 'Creating workbook object
Set SheetObject = objWB.Worksheets("Sheet1") 'worksheets are a member of workbooks, not the Excel Application (Creating sheet object)

'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:\Users\MOHDSABRY\Desktop\Converter\taskCon\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)

CountHeader = 2 'to set row number for Excel paste
CountDetail = 4
CountTrailer = 26

SheetObject.Columns(1).NumberFormat = "@"
SheetObject.Columns(2).NumberFormat = "@"
SheetObject.Columns(3).NumberFormat = "@"
SheetObject.Columns(4).NumberFormat = "@"
SheetObject.Columns(5).NumberFormat = "@"
SheetObject.Columns(6).NumberFormat = "@"
SheetObject.Columns(7).NumberFormat = "@"
SheetObject.Columns(8).NumberFormat = "@"
SheetObject.Columns(9).NumberFormat = "@"
SheetObject.Columns(10).NumberFormat = "@"
SheetObject.Columns(11).NumberFormat = "@"
SheetObject.Columns(12).NumberFormat = "@"
SheetObject.Columns(13).NumberFormat = "@"
SheetObject.Columns(14).NumberFormat = "@"
SheetObject.Columns(15).NumberFormat = "@"

SheetObject.Cells(1, 1).Value = "Record Type"
SheetObject.Cells(1, 2).Value = "Sequence No"
SheetObject.Cells(1, 3).Value = "Contract No"
SheetObject.Cells(1, 4).Value = "Creation By"
SheetObject.Cells(1, 5).Value = "Transaction Date"
SheetObject.Cells(1, 6).Value = "Total Record"
SheetObject.Cells(1, 7).Value = "Total Amount"
SheetObject.Cells(1, 8).Value = "Source"
SheetObject.Cells(1, 9).Value = "Filler"

SheetObject.Cells(3, 1).Value = "Record Type"
SheetObject.Cells(3, 2).Value = "Sequence No"
SheetObject.Cells(3, 3).Value = "Contract No"
SheetObject.Cells(3, 4).Value = "Payment Type"
SheetObject.Cells(3, 5).Value = "Settlement Type"
SheetObject.Cells(3, 6).Value = "Effective Date"
SheetObject.Cells(3, 7).Value = "Credit Account No."
SheetObject.Cells(3, 8).Value = "Cr. Transaction Amount"
SheetObject.Cells(3, 9).Value = "Loan Type"
SheetObject.Cells(3, 10).Value = "Bank Employee ID"
SheetObject.Cells(3, 11).Value = "ID Number"
SheetObject.Cells(3, 12).Value = "ID Type Code"
SheetObject.Cells(3, 13).Value = "Bank Employee Name"
SheetObject.Cells(3, 14).Value = "HRIS Process Status"
SheetObject.Cells(3, 15).Value = "Total Record"
SheetObject.Cells(3, 16).Value = "CIF Number"
SheetObject.Cells(3, 17).Value = "Account Branch"

SheetObject.Cells(25, 1).Value = "Record Type"
SheetObject.Cells(25, 2).Value = "Sequence No"
SheetObject.Cells(25, 3).Value = "Contract No"
SheetObject.Cells(25, 4).Value = "Total Record"
SheetObject.Cells(25, 5).Value = "Total Amount"
SheetObject.Cells(25, 6).Value = "Filler"

Do Until TextRead.AtEndOfStream
    Line = TextRead.ReadLine

    If Left(Line, 1) = "H" Then
        SheetObject.Cells(CountHeader, 1).Value = Mid(Line, 1, 1)
        SheetObject.Cells(CountHeader, 2).Value = Mid(Line, 2, 9)
        SheetObject.Cells(CountHeader, 3).Value = Mid(Line, 11, 19)
        SheetObject.Cells(CountHeader, 4).Value = Mid(Line, 30, 1)
        SheetObject.Cells(CountHeader, 5).Value = Mid(Line, 31, 8)
        SheetObject.Cells(CountHeader, 6).Value = Mid(Line, 39, 9)
        SheetObject.Cells(CountHeader, 7).Value = Mid(Line, 48, 17)
        SheetObject.Cells(CountHeader, 8).Value = Mid(Line, 65, 2)
        SheetObject.Cells(CountHeader, 9).Value = Mid(Line, 67, 334)
    ElseIf Left(Line, 1) = "D" Then
        SheetObject.Cells(CountDetail, 1).Value = Mid(Line, 1, 1) 'HeaderRecordType to column A
        SheetObject.Cells(CountDetail, 2).Value = Mid(Line, 2, 9) 'ValueHeaderSequenceNo to column b
        SheetObject.Cells(CountDetail, 3).Value = Mid(Line, 11, 19) 'HeaderContractNo to column C
        SheetObject.Cells(CountDetail, 4).Value = Mid(Line, 30, 10)
        SheetObject.Cells(CountDetail, 5).Value = Mid(Line, 40, 1)
        SheetObject.Cells(CountDetail, 6).Value = Mid(Line, 41, 8)
        SheetObject.Cells(CountDetail, 7).Value = Mid(Line, 49, 19)
        SheetObject.Cells(CountDetail, 8).Value = Mid(Line, 68, 1)
        SheetObject.Cells(CountDetail, 9).Value = Mid(Line, 69, 17)
        SheetObject.Cells(CountDetail, 10).Value = Mid(Line, 86, 10)
        SheetObject.Cells(CountDetail, 11).Value = Mid(Line, 96, 40)
        SheetObject.Cells(CountDetail, 12).Value = Mid(Line, 136, 40)
        SheetObject.Cells(CountDetail, 13).Value = Mid(Line, 176, 3)
        SheetObject.Cells(CountDetail, 14).Value = Mid(Line, 179, 200)
        SheetObject.Cells(CountDetail, 15).Value = Mid(Line, 379, 1)
        SheetObject.Cells(CountDetail, 16).Value = Mid(Line, 380, 19)
        SheetObject.Cells(CountDetail, 17).Value = Mid(Line, 399, 5)
    ElseIf Left(Line, 1) = "T" Then
        SheetObject.Cells(CountTrailer, 1).Value = Mid(Line, 1, 1)
        SheetObject.Cells(CountTrailer, 2).Value = Mid(Line, 2, 9)
        SheetObject.Cells(CountTrailer, 3).Value = Mid(Line, 30, 9)
        SheetObject.Cells(CountTrailer, 4).Value = Mid(Line, 39, 17)
        SheetObject.Cells(CountTrailer, 5).Value = Mid(Line, 65, 2)
        SheetObject.Cells(CountTrailer, 6).Value = Mid(Line, 56, 354)
    Else
        'Error Handling..
    End If

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

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

Click This for more explaination of the tables.In one sheet divided into 3.

Answer 1

您在计数标题后留出两行空间。然而，您在每个循环中都增加了 countheader 变量。

我认为您应该将各个增加者移到相应的 If 子句中:

  If Left(Line, 1) = "H" Then

        SheetObject.Cells(CountHeader, 1).Value = Mid(Line, 1, 1)
        ....
        SheetObject.Cells(CountHeader, 9).Value = Mid(Line, 67, 334)
        CountHeader=CountHeader+1
    ElseIf Left(Line, 1) = "D" Then
        SheetObject.Cells(CountDetail, 1).Value = Mid(Line, 1, 1) 'HeaderRecordType to column A
        SheetObject.Cells(CountDetail, 2).Value = Mid(Line, 2, 9) 'ValueHeaderSequenceNo to column b
        ....
        SheetObject.Cells(CountDetail, 17).Value = Mid(Line, 399, 5)
        CountDetail=CountDetail+1

或者，您将 3 个部分制作为仅两行高，将标题放在第一个部分中，并在需要时插入一行:

Sub WriteHeaders(aRange As Range, aHeaders As String)
    Dim arr() As String
    arr() = Split(aHeaders, "|")
    aRange.Resize(1, UBound(arr) + 1) = arr
End Sub

Sub ReadMyFile()
  Dim objFSO
  Dim TextFile
  Dim TextRead
  Dim Line, Line1, Line2, Line3
  Dim Count

  ExcelFilePath = "C:\Users\MOHDSABRY\Desktop\Converter\taskCon\Output.xlsx"
  Set objExcel = CreateObject("Excel.Application")'Creating excel object
  Set objWB = objExcel.Workbooks.Open(ExcelFilePath) 'Creating workbook object
  Set SheetObject = objWB.Worksheets("Sheet1") 'worksheets are a member of workbooks, not the Excel Application (Creating sheet object)

  Const ForReading = 1 'Constant declared so that can be used throughout the script
  TextFile = "C:\Users\MOHDSABRY\Desktop\Converter\taskCon\HRILOANDIC20170601.txt"
  set objFSO = CreateObject("Scripting.FileSystemObject")
  set TextRead = objFSO.OpenTextFile(TextFile,ForReading)
  CountHeader = 2
  CountDetail = 4
  CountTrailer = 6

  WriteHeaders SheetObject.Rows(1), "Record Type|Sequence No|Contract No|Creation By|Transaction Date|Total Record|Total Amount|Source|Filler"
  WriteHeaders SheetObject.Rows(3), "Record Type|Sequence No|Contract NoPayment Type|Settlement Type|Effective Date|Credit Account No.|Cr. Transaction Amount|Loan Type|Bank Employee ID|ID Number|ID Type Code|Bank Employee Name|HRIS Process Status|Total Record|CIF Number|Account Branch"
  WriteHeaders SheetObject.Rows(5), "Record Type|Sequence No|Contract No|Total Record|Total Amount|Filler"

  Select Case Left(Line, 1)
  Case "H"
      SheetObject.Rows(CountHeader).Insert xlDown, xlFormatFromLeftOrAbove
      SheetObject.Cells(CountHeader, 1).Value = Mid(Line, 1, 1)
      SheetObject.Cells(CountHeader, 2).Value = Mid(Line, 2, 9)
      '...
      SheetObject.Cells(CountHeader, 9).Value = Mid(Line, 67, 334)
      CountHeader = CountHeader + 1
      CountDetail = CountDetail + 1
      CountTrailer = CountTrailer + 1
  ElseIf Left(Line, 1) = "D" Then
      SheetObject.Rows(CountDetail).Insert xlDown, xlFormatFromLeftOrAbove
      SheetObject.Cells(CountDetail, 1).Value = Mid(Line, 1, 1) 'HeaderRecordType to column A
      SheetObject.Cells(CountDetail, 2).Value = Mid(Line, 2, 9) 'ValueHeaderSequenceNo to column b
      '...
      SheetObject.Cells(CountDetail, 17).Value = Mid(Line, 399, 5)
      CountDetail = CountDetail + 1
      CountTrailer = CountTrailer + 1
  ElseIf Left(Line, 1) = "T" Then
      SheetObject.Rows(CountTrailer).Insert xlDown, xlFormatFromLeftOrAbove
      SheetObject.Cells(CountTrailer, 1).Value = Mid(Line, 1, 1)
      SheetObject.Cells(CountTrailer, 2).Value = Mid(Line, 2, 9)
      '...
      SheetObject.Cells(CountTrailer, 6).Value = Mid(Line, 56, 354)
      CountTrailer = CountTrailer + 1
  Else
      '....