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

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

这是一份样本记录。对于每个独特的索赔，我们需要提取第一个索赔总额，希望以两列列表结束：

[索赔][索赔总额]

====================================================================================================================================
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: 

---

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

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

输出：

---

这太棒了！谢谢你的支持。我不是程序员，我只是一个系统人员。我对代码了如指掌，了解它的功能，并进行更改，但我无法从头开始构建代码。再次感谢你！