Excel的文本文件涉及一个工作表中的多个表

时间:2015-12-08 15:08:15

标签: excel vba excel-vba vbscript

我被分配创建了一个转换器,用于将文本文件转换为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

Sample output after converted with no title

以下示例代码显示了我如何尝试为每个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.

1 个答案:

答案 0 :(得分:0)

在count-header之后留出两行空格。然而,你在每个循环中增加了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
      '....