使用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行,您只需使用一个变量来计算行数然后在第一次检查DT行时添加标题。我创建了一个pseudo-Boolean变量来确定何时添加DT的标头。 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