excel - 使用字符串操作从 Excel 解析文本文件

Question

下面是一个解析程序的例子。它从文本文件中获取文本并使用字符串操作和几个循环来解析数据:

    Dim myFile As String
    Dim text As String
    Dim textline As String
    Dim cstAct as integer
    Dim actOpe as integer
    Dim cusNam as integer
    Dim act as integer
    Dim reg as integer

    myFile = "put file patch to text file here"
    myFile = Application.GetOpenFilename()

这是 do 循环，一旦它到达第 3 行(下一个帐户记录)，我想暂停

    Do Until EOF(1)
      Line Input #1, textline
      text = text & textline
    Loop

    cusAct = InStr(text, "ACCOUNT ")
    actOpe = InStr(text, "ACCOUNT OPEN:")
    reg = InStr(text, "REGION:")
    cusNam = InStr(text, "CUSTOMER NAME:")

这是我希望在 do...loop 停止后执行的 for...loop 或“在到达下一条记录后暂停”

    For i = 2 To ThisWorkbook.Worksheets("b2").Range("a65536").End(xlUp).Row
      ThisWorkbook.Worksheets("name").Range("a" & i).Value = Mid(text, cstAct + 6, 9)
      ThisWorkbook.Worksheets("name").Range("b" & i).Value = Mid(text, actOpe + 13, 27)
      ThisWorkbook.Worksheets("name").Range("c" & i).Value = Mid(text, reg + 6, 9)
      ThisWorkbook.Worksheets("name").Range("d" & i).Value = Mid(text, cusNam  + 20, 19)

这是我想恢复“do...loop”的地方，以便新的子字符串(即 987654321 将是由 Mid(text, cstAct + 6, 9) 产生的新子字符串)各自的父字符串(即帐户)刷新可以这么说
否则，第 1 行和第 2 行将一遍又一遍地循环。

    next i

下面是示例文本文件的示例:

    ACCOUNT ABCDEF12                                                                 
    ACCOUNT OPEN:     05/10/15              ACT TYPE: PREMIUM          
    CUSTOMER NAME:    JOHN B. SMITH         CSA REP:  154983                   
    CUSTOMER ADDRESS: 123 SOMEWHERE DRIVE   SOMETHING HERE:                   
    LAST ORDER:       06/24/2011             COUNTRY CODE: UNITED STATES      
    INVOICE #:        123456789             STATE CODE:    CALIFORNIA         
    LAST MAINTENANCE: 01/02/15               COUNTY CODE:  UNCODED            
    SOME INDICATOR:   NO   COMPLAINTS: NO   IPM IND:       DATAPREP/PERF4     
    SOME INDICATOR:   NO STATUS:  NONE      AUTO RENEW:    YES                
    SOMETHING HERE:   NO                             
    SOMETHING HERE:          ABC IND:       
    SOMETHING HERE:   2    ABC ASSET NO:  T                                           
    ACCOUNT ZXYFDG13                                                                 
    ACCOUNT OPEN:     05/10/15              ACT TYPE: PREMIUM          
    CUSTOMER NAME:    JANE B. SMITH         CSA REP:  154983                   
    CUSTOMER ADDRESS: 123 SOMEWHERE DRIVE   SOMETHING HERE:                   
    LAST ORDER:       06/24/2011             COUNTRY CODE: UNITED STATES      
    INVOICE #:        123456789             STATE CODE:    CALIFORNIA         
    LAST MAINTENANCE: 01/02/15               COUNTY CODE:  UNCODED            
    SOME INDICATOR:   NO   COMPLAINTS: NO   IPM IND:       DATAPREP/PERF4     
    SOME INDICATOR:   NO STATUS:  NONE      AUTO RENEW:    YES                
    SOMETHING HERE:   NO                             
    SOMETHING HERE:          ABC IND:  NO     
    SOMETHING HERE:   2    REGION:  NE                       

在不调整上述代码结构的情况下，excel中的输出将如下所示:

            A           B           C     D
    ROW 1   123456789   00/00/0000  NY    JON SMITH
    ROW 2   123456789   00/00/0000  NY    JON SMITH

我试图让它看起来像这样:

            A           B           C     D
    ROW 1   123456789   00/00/0000  NY    JON SMITH
    ROW 2   987654321   00/00/0000  FL    JANE SMITH

关于如何最好地做到这一点的任何想法？

Answer 1

如果您知道每个“记录类型”的文字结构，那么您可以将它们声明为 VBA User Defined Type阅读(和写作)的结构。此外，看起来您可以通过稍微不同的代码设计来简化工作并改进错误处理。

考虑一下我将如何使用 UDF 来解决这个问题，这使得代码更具可读性，因此更易于维护:-

'Always set this to ensure you have all variables declared
Option Explicit

'User Defined Types for each record format
Private Type AccountInfoType
  OpenText As String * 18           'Absorb all text and prefixes up to data
  OpenDate As String * 8           'Contains the data
  AccTypeText As String * 24        'Absorb all text and prefixes up to data
  AccType As String * 7             'Contains the data
  'Add additional fields here
  CRLF As String * 2                'CR/LF character
End Type

Private Type CustomerNameType
  NameText As String * 18           'Absorb all text and prefixes up to data
  Name As String * 20               'Contains the data
  CsaRepText As String * 12         'Absorb all text and prefixes up to data
  CsaRep As String * 6              'Contains the data
  'Add additional fields here
  CRLF As String * 2                'CR/LF character
End Type

Private Type AddressType
  AddressText As String * 18        'Absorb all text and prefixes up to data
  AddressData As String * 20        'Contains the data
  SomethingHereText As String * 17  'Absorb remaining text
  'Add additional fields here
  CRLF As String * 2                'CR/LF character
End Type

Private Type LastOrderType
  LastOrderText As String * 18      'Absorb all text and prefixes up to data
  LastOrderDate As String * 10      'Contains the data
  CountryText As String * 27        'Absorb all text and prefixes up to data
  Country As String * 13            'Contains the data
  'Add additional fields here
  CRLF As String * 2                'CR/LF character
End Type

Private Type InvoiceType
  InvoiceText As String * 18        'Absorb all text and prefixes up to data
  InvoiceNumber As String * 9       'Contains the data
  StateText As String * 28          'Absorb all text and prefixes up to data
  State As String * 10              'Contains the data
  'Add additional fields here
  CRLF As String * 2                'CR/LF character
End Type

Sub ParseFile()

  Dim wb As Workbook
  Dim ws As Worksheet

  Dim row As Long

  Dim dataRecord As String

  Dim accountNumber As String
  Dim accountInfo As AccountInfoType
  Dim customerName As CustomerNameType
  Dim address As AddressType
  Dim lastOrder As LastOrderType
  Dim invoice As InvoiceType

  Dim myFile As Variant


  'Consider using proper error handling
  On Error GoTo ParseFileZ

  myFile = Application.GetOpenFilename()

  If myFile = False Then
    'Not a fan of GoTo but better than running the whole method inside if/then block
    GoTo ParseFileX
  End If

  'I started with a new workbook. Change this to open an exsting workbook if desired
  Set wb = Application.Workbooks.Add

  'Set this handle to your desired worksheet
  Set ws = wb.Worksheets(1)

  'Set up column headers here. I chose row 3 to allow for a heading in row 1. Choose your own...
  ws.Range("A3").Value = "Acc Number"
  ws.Range("B3").Value = "Acc Opened"
  ws.Range("C3").Value = "Region"
  ws.Range("D3").Value = "Name"

  'Base output row in the worksheet
  row = 3

  'Open the file in binary mode so that you can use User Defined Types to read each record
  Open CStr(myFile) For Binary As #1

  While Not EOF(1)

    'Read next record
    Input #1, dataRecord

    'Find the first record of the next account - otherwise, skip until you get one
    If Left(dataRecord, 7) = "ACCOUNT" And Len(dataRecord) = 16 Then

      'Found the Account Number record. This is the start of the next account
      accountNumber = Mid(dataRecord, 9, 8)

      Get #1, , accountInfo  'Read the Account info record
      Get #1, , customerName 'Read the Customer Name record
      Get #1, , address      'Read the Address record
      Get #1, , lastOrder    'Read the Last Order record
      Get #1, , invoice      'read the Invoice record

      'Ignore the remaining records unless you want to get more data. The "Read Next Record" loop will skip them

      'Get the next row number on the output worksheet to write values to
      row = row + 1

      'Assign the values from the various records
      ws.Cells(row, 1).Value = Trim(accountNumber)
      ws.Cells(row, 2).Value = Trim(accountInfo.OpenDate)
      ws.Cells(row, 3).Value = Trim(invoice.State)  '(you talk about "region" but no region in data sample)
      ws.Cells(row, 4).Value = Trim(customerName.Name)
      'Add more cells for additional records you want to extra fields from here

    End If

  Wend

  'We're finished. Close the file
  Close #1

  'Resize the cells for readibilty
  ws.Cells.EntireColumn.AutoFit

ParseFileX:

  'Disable error handling
  On Error GoTo 0

  'Be a good memory citizen
  Set ws = Nothing
  Set wb = Nothing

  Exit Sub

ParseFileZ:
  MsgBox Err.Number & " - " & Err.Description, "Error occurred"
  Resume ParseFileX

End Sub