从格式化的纯文本中解析数据

Question

我正在尝试定期从.PDF报告中提取结算。该报告是纯文本，下面列出了一个记录示例。手动提取结算数据并不困难，这只是耗时，因为报告可以是1000个记录。我需要能够将此任务传递给非技术人员，因此理想情况下，在将文本复制/粘贴到.PDF之后，可以使用Excel 2016或Word 2016解析数据。

这是一个示例记录。对于每个唯一的声明＃，我们需要提取第一个声明总计，希望以2列列表结束：

[声明＃] [声明总计]

====================================================================================================================================
Ins. Co. Name: XXXX [XXXXXXXXX] EFT #: XXXXXX EFT Date: XX/XX/XXXX
Claim #: 9999999
Patient Name: XXXXXXX,XXXXXXXX X Date of Birth: X/XX/XXXX Patient Acct#: XXXXXXXXXX
Member ID: XXXXXXXXX Group: XXXXX-XX [XXXXXXXXX]
SERVICE PROCEDURE DISCOUNT/ PATIENT PP ADJST NET PRIMARY PRIMARY
DATE /DRG BILLED DISALLOWED CODE PORTION CODE ADJUSTMENT REASON WITHHOLD PAYMENT INSURANCE PAT PORT
========== ========= ========== ========== ========== ========== ==== ========== ====== ========== ========== ========== ==========
06/14/2017 S5102 76.27 0.00 288,289,C 0.00 4 0.00 76.27
06/15/2017 S5102 76.27 0.00 288,289,C 0.00 4 0.00 76.27
06/16/2017 S5102 76.27 0.00 288,289,C 0.00 4 0.00 76.27
---------- ---------- ---------- ---------- ---- ---------- ------ ---------- ---------- ---------- ----------
Claim Totals: 228.81 0.00 0.00 0.00 0.00 228.81 0.00 0.00
CLAIM EOB SUMMARY
----------------------------------------
Claim Level Code: 
Claim Level Code: 
Interest Amount: 0.00
Penalty Amount: 0.00
PROCEDURE EOB/ADJUSTMENT SUMMARY
----------------------------------
Reason Code: 
Patient Portion Code: 

Answer 1

这将要求用户选择.txt文件，然后它会将其读出。它基本上只是通过每一行，并检查开头是否匹配
Claim #等等。它将使用文件名输出新工作表上的数据，如果它已经存在，它将不执行任何操作。

Private Sub Read()
Dim fn As Variant, txt As String, x As Variant, Errors As Variant
Dim sht As Worksheet
Dim fname As String
Dim arr() As Variant, vTotal As Variant
Dim j As Long, k As Long: j = 2: k = 0

fn = Application.GetOpenFilename("Text Files (*.txt),*.txt", , _
       "Open File")
fname = Right(fn, Len(fn) - InStrRev(fn, "\"))
If fn = False Or sheetExists(fname) Then Exit Sub

Application.ScreenUpdating = False
Set sht = Worksheets.Add
sht.Name = fname
sht.Cells(1, 1).Value = "Claim #"
sht.Cells(1, 2).Value = "Claim Total"
txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
x = Split(txt, vbNewLine)
For i = LBound(x) To UBound(x)
    If Left(x(i), 8) = "Claim #:" Then
        If sht.Cells(j, 1).Value <> "" Then
            sht.Cells(j, 2).Value = "Not Found"
            j = j + 1
        End If
        sht.Cells(j, 1).Value = Right(x(i), Len(x(i)) - 9)
    ElseIf Left(x(i), 13) = "Claim Totals:" Then
        vTotal = Split(x(i), " ")
        sht.Cells(j, 2).Value = vTotal(2)
        j = j + 1
    End If
Next i
Application.ScreenUpdating = True
End Sub

Function sheetExists(sheetToFind As String) As Boolean
    sheetExists = False
    For Each Sheet In Worksheets
        If sheetToFind = Sheet.Name Then
            sheetExists = True
            Exit Function
        End If
    Next Sheet
End Function

输出：