フォーマットされたプレーンテキストからデータを解析しています

Question

定期的に.PDFレポートの請求を取り出そうとしています。レポートはプレーンテキストで、1つのレコードの例を以下に示します。手動で請求データを引き出すことは難しくありません。レポートが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 

出力：