Vba 使用vbscript将未定义的数据行从文本文件转换为excel

到目前为止，我创建了这段代码，这只针对定义的行数，因为我们为每个标题列设置了计数器。如果新批文件包含新的行数，会发生什么情况？如何开始创建此代码

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 = 28

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(27, 1).Value = "Record Type"
SheetObject.Cells(27, 2).Value = "Sequence No"
SheetObject.Cells(27, 3).Value = "Contract No"
SheetObject.Cells(27, 4).Value = "Total Record"
SheetObject.Cells(27, 5).Value = "Total Amount"
SheetObject.Cells(27, 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)
        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, 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)
        CountDetail = CountDetail + 1

    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)
        CountTrailer = CountTrailer + 1
    Else
    'Error Handling..
    End If

     'to move down the Excel row to paste for each line in the text fix
Loop

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

---

由于数据总是以相同的模式出现，即所有

H

行先出现，然后是

D

行，然后是

T

行，因此您可以只使用一个变量来计算行数，然后检查

D

或

T

行第一次出现时添加标题。我制作了一个

pseudo Boolean

变量来确定何时为

D

和

T

添加标题<代码>H标题在第1行保持不变

经过充分测试的代码：

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
objExcel.visible = true
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)

row = 2 'start with row to set cell values

With SheetObject

    'format column as text
    .Range(.Columns(1),.Columns(15)).NumberFormat = "@"

    'set `H` headers since its always row 1
    .Cells(1, 1).Value = "Record Type"
    .Cells(1, 2).Value = "Sequence No"
    .Cells(1, 3).Value = "Contract No"
    .Cells(1, 4).Value = "Creation By"
    .Cells(1, 5).Value = "Transaction Date"
    .Cells(1, 6).Value = "Total Record"
    .Cells(1, 7).Value = "Total Amount"
    .Cells(1, 8).Value = "Source"
    .Cells(1, 9).Value = "Filler"

    Do Until TextRead.AtEndOfStream

        Line = TextRead.ReadLine

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

            .Cells(row, 1).Value = Mid(Line, 1, 1)
            .Cells(row, 2).Value = Mid(Line, 2, 9)
            .Cells(row, 3).Value = Mid(Line, 11, 19) 
            .Cells(row, 4).Value = Mid(Line, 30, 1)
            .Cells(row, 5).Value = Mid(Line, 31, 8)
            .Cells(row, 6).Value = Mid(Line, 39, 9)
            .Cells(row, 7).Value = Mid(Line, 48, 17) 
            .Cells(row, 8).Value = Mid(Line, 65, 2)
            .Cells(row, 9).Value = Mid(Line, 67, 334)

            row = row +1

        ElseIf Left(Line,1) = "D" Then

            Dim bD 'as Boolean 

            If Not bD Then 'means its the first D row so set headers

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

                'add 1 row to paste data again
                row = row + 1

                'set variable so code knows headers have been set
                bD = True

            End If

            .Cells(row, 1).Value = Mid(Line, 1, 1) 'HeaderRecordType to column A
            .Cells(row, 2).Value = Mid(Line, 2, 9) 'ValueHeaderSequenceNo to column b
            .Cells(row, 3).Value = Mid(Line, 11, 19) 'HeaderContractNo to column C
            .Cells(row, 4).Value = Mid(Line, 30, 10) 
            .Cells(row, 5).Value = Mid(Line, 40, 1)
            .Cells(row, 6).Value = Mid(Line, 41, 8)      
            .Cells(row, 7).Value = Mid(Line, 49, 19) 
            .Cells(row, 8).Value = Mid(Line, 68, 1)
            .Cells(row, 9).Value = Mid(Line, 69, 17) 
            .Cells(row, 10).Value = Mid(Line, 86, 10) 
            .Cells(row, 11).Value = Mid(Line, 96, 40) 
            .Cells(row, 12).Value = Mid(Line, 136, 40) 
            .Cells(row, 13).Value = Mid(Line, 176, 3)
            .Cells(row, 14).Value = Mid(Line, 179, 200) 
            .Cells(row, 15).Value = Mid(Line, 379, 1)
            .Cells(row, 16).Value = Mid(Line, 380, 19)
            .Cells(row, 17).Value = Mid(Line, 399, 5)

            row = row  + 1 

        ElseIf Left(Line,1) = "T" Then

            Dim bT 'as Boolean 

            If Not bT Then 'means its the first T row so set headers

                'now set 'T' headers because 'D' is finished
                .Cells(row, 1).Value = "Record Type"
                .Cells(row, 2).Value = "Sequence No"
                .Cells(row, 3).Value = "Contract No"
                .Cells(row, 4).Value = "Total Record"
                .Cells(row, 5).Value = "Total Amount"
                .Cells(row, 6).Value = "Filler"

                'add 1 row to paste data again
                row = row + 1

                'set variable so code knows headers have been set
                bT = True

            End If

            .Cells(row, 1).Value = Mid(Line, 1, 1)
            .Cells(row, 2).Value = Mid(Line, 2, 9)
            .Cells(row, 3).Value = Mid(Line, 30, 9)
            .Cells(row, 4).Value = Mid(Line, 39, 17) 
            .Cells(row, 5).Value = Mid(Line, 65, 2)
            .Cells(row, 6).Value = Mid(Line, 56, 354)

            row = row + 1

        Else
            'catch errors 

        End If

     'to move down the Excel row to paste for each line in the text fix
    Loop

End With

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

---

使用

while（…）{…}

循环？仅供参考，我很确定您可以将所有这些行组合成一行：

SheetObject.Range（第（1）列、第（15）列）。NumberFormat=“@”

@Draco18s-

执行while（…）循环

如果行始终有序，则该循环将起作用，这意味着前2行（或3行、4行或n行）始终

H

，接下来的x行总是

D

，接下来的x行是

T

。。。如果没有，OP必须首先获得每个字母的行数，并使用它设置

CountHeader、CountDetail、counttraile

变量。啊，是的，这将是一个问题。他需要某种分隔符来告诉程序它需要从一种情况更改为另一种情况。@BruceWayne和OP-Headers也可以这样设置，例如，缩短代码：

SheetObject（范围（单元格（27,1），单元格（27,6））.Value=Array（“记录类型”，“序列号”，“合同号”，“总记录”，“总金额”，“填料”）

你真是超级天才，我甚至都没想过。如何成为和你一样的人？哈哈……非常感谢你，伙计……真的很感激。：@user3143305-有时候，当你离问题如此近的时候，很难想出解决办法。拥有第二双眼睛会有帮助：）