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

时间：2015-12-08 18:25:56

标签： excel vba excel-vba vbscript

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

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

Raw Data Example

1 个答案:

答案 0 :(得分：1)

由于您的数据始终采用与首先出现的所有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
相关问题
最新问题