7

vbaを使用してPDFファイルからテーブルを抽出し、Excelにエクスポートしようとしています。すべてが正常に機能する場合は、すべて自動で実行する必要があります。問題は、テーブルが標準化されていないことです。

これは私がこれまでに持っているものです。

  1. VBA(Excel)はXPDFを実行し、現在のフォルダーにあるすべての.pdfファイルをテキストファイルに変換します。
  2. VBA(Excel)は、各テキストファイルを1行ずつ読み取ります。

そしてコード:

With New Scripting.FileSystemObject
With .OpenTextFile(strFileName, 1, False, 0)

    If Not .AtEndOfStream Then .SkipLine
    Do Until .AtEndOfStream
        //do something
    Loop
End With
End With

これはすべてうまくいきます。しかし今、私はテキストファイルからテーブルを抽出する問題に直面しています。私がやろうとしているのは、VBAで「Year'sIncome」などの文字列を見つけて、その後のデータを列に出力することです。(テーブルが終了するまで。)

最初の部分はそれほど難しくありませんが(特定の文字列を見つける)、2番目の部分についてはどうすればよいでしょうか。テキストファイルはこのPastebinのようになります。問題は、テキストが標準化されていないことです。したがって、たとえば、一部のテーブルには3年の列(2010 2011 2012)と2つ(または1)のみがあり、一部のテーブルには列の間にさらにスペースがあり、一部のテーブルには特定の行(Capital Asset、netなど)が含まれていません。

私はこのようなことを考えていましたが、VBAでそれをどうやって行うのかわかりませんでした。

  1. ユーザー定義の文字列を検索します。例えば。「表1:年のリターン。」
  2. a。次の行は年を見つけます。2つある場合は出力に3つの列(タイトル+、2x年)が必要になり、3つある場合は4つ(タイトル+、3x年)が必要になります
    。各年のタイトル列+列を作成します。
  3. 行末に達したら、次の行に移動します
  4. a。テキストを読む->列1に出力します
    。b。スペース(スペース> 3ですか?)を列2の開始として認識します。数値を読み取り、列2に出力します
    。c。(列= 3の場合)スペースを列3の開始として認識します。数値を読み取り、列3に出力します
    。d。(列= 4の場合)スペースを列4の開始として認識します。数値を読み取り、列4に出力します。
  5. 各行、ループ4。
  6. 次の行には数字が含まれていません-テーブルを終了します。(おそらく、ユーザー定義の数字だけで簡単です。15文字の後に数字はありませんか?終了テーブル)

私は最初のバージョンをPDFに基づいて優れていますが、オンラインで読むことはお勧めしませんOpenFileが、むしろFileSystemObject(かなり遅いように見えますが)。

主にステップ2で、私を始めるための指針はありますか?

4

3 に答える 3

1

テキストファイルを分析する方法はいくつかありますが、その複雑さに応じて、何らかの方法で傾く可能性があります。私はこれを始めました、そしてそれは少し手に負えなくなりました...楽しんでください。

あなたが提供したサンプルと追加のコメントに基づいて、私は次のことに気づきました。これらのいくつかは単純なファイルではうまく機能するかもしれませんが、より大きくより複雑なファイルでは扱いにくくなる可能性があります。さらに、私がここで使用したものには少し効率的な方法やトリックがあるかもしれませんが、これは間違いなくあなたが望ましい結果を達成するためにあなたを動かすでしょう。うまくいけば、これは提供されたコードと組み合わせて意味があります:

  • ブール値を使用InStrして、現在のテキストファイルの「セクション」を特定できます。つまり、現在の行で「テーブル」というテキストを検索してテーブル内にいることを確認し、ファイルの「テーブル」セクションが「アセット」セクションなどの検索を開始します
  • いくつかの方法を使用して、年数(または列)を判別できます。Splitループを伴う関数がその役割を果たします。
  • 特定の部分だけでも、ファイルのフォーマットが常に一定である場合は、これを利用できます。たとえば、ファイル行の前に常にドル記号が付いていることがわかっている場合は、これによって列幅が定義され、後続のテキスト行でこれを使用できます。

次のコードは、テキストファイルからアセットの詳細を抽出します。他のセクションを抽出するように変更できます。複数の行を処理する必要があります。うまくいけば、私はそれを十分にコメントしました。ご覧になり、さらにサポートが必要な場合は編集します。

 Sub ReadInTextFile()
    Dim fs As Scripting.FileSystemObject, fsFile As Scripting.TextStream
    Dim sFileName As String, sLine As String, vYears As Variant
    Dim iNoColumns As Integer, ii As Integer, iCount As Integer
    Dim bIsTable As Boolean, bIsAssets As Boolean, bIsLiabilities As Boolean, bIsNetAssets As Boolean

    Set fs = CreateObject("Scripting.FileSystemObject")
    sFileName = "G:\Sample.txt"
    Set fsFile = fs.OpenTextFile(sFileName, 1, False)

    'Loop through the file as you've already done
    Do While fsFile.AtEndOfStream <> True
        'Determine flag positions in text file
        sLine = fsFile.Readline

        Debug.Print VBA.Len(sLine)

        'Always skip empty lines (including single spaceS)
        If VBA.Len(sLine) > 1 Then

            'We've found a new table so we can reset the booleans
            If VBA.InStr(1, sLine, "Table") > 0 Then
                bIsTable = True
                bIsAssets = False
                bIsNetAssets = False
                bIsLiabilities = False
                iNoColumns = 0
            End If

            'Perhaps you want to also have some sort of way to designate that a table has finished.  Like so
            If VBA.Instr(1, sLine, "Some text that designates the end of the table") Then
                bIsTable = False
            End If 

            'If we're in the table section then we want to read in the data
            If bIsTable Then
                'Check for your different sections.  You could make this constant if your text file allowed it.
                If VBA.InStr(1, sLine, "Assets") > 0 And VBA.InStr(1, sLine, "Net") = 0 Then bIsAssets = True: bIsLiabilities = False: bIsNetAssets = False
                If VBA.InStr(1, sLine, "Liabilities") > 0 Then bIsAssets = False: bIsLiabilities = True: bIsNetAssets = False
                If VBA.InStr(1, sLine, "Net Assests") > 0 Then bIsAssets = True: bIsLiabilities = False: bIsNetAssets = True

                'If we haven't triggered any of these booleans then we're at the column headings
                If Not bIsAssets And Not bIsLiabilities And Not bIsNetAssets And VBA.InStr(1, sLine, "Table") = 0 Then
                    'Trim the current line to remove leading and trailing spaces then use the split function to determine the number of years
                    vYears = VBA.Split(VBA.Trim$(sLine), " ")
                    For ii = LBound(vYears) To UBound(vYears)
                        If VBA.Len(vYears(ii)) > 0 Then iNoColumns = iNoColumns + 1
                    Next ii

                    'Now we can redefine some variables to hold the information (you'll want to redim after you've collected the info)
                    ReDim sAssets(1 To iNoColumns + 1, 1 To 100) As String
                    ReDim iColumns(1 To iNoColumns) As Integer
                Else
                    If bIsAssets Then
                        'Skip the heading line
                        If Not VBA.Trim$(sLine) = "Assets" Then
                            'Increment the counter
                            iCount = iCount + 1

                            'If iCount reaches it's limit you'll have to redim preseve you sAssets array (I'll leave this to you)
                            If iCount > 99 Then
                                'You'll find other posts on stackoverflow to do this
                            End If

                            'This will happen on the first row, it'll happen everytime you
                            'hit a $ sign but you could code to only do so the first time
                            If VBA.InStr(1, sLine, "$") > 0 Then
                                iColumns(1) = VBA.InStr(1, sLine, "$")
                                For ii = 2 To iNoColumns
                                    'We need to start at the next character across
                                    iColumns(ii) = VBA.InStr(iColumns(ii - 1) + 1, sLine, "$")
                                Next ii
                            End If

                            'The first part (the name) is simply up to the $ sign (trimmed of spaces)
                            sAssets(1, iCount) = VBA.Trim$(VBA.Mid$(sLine, 1, iColumns(1) - 1))
                            For ii = 2 To iNoColumns
                                'Then we can loop around for the rest
                                sAssets(ii, iCount) = VBA.Trim$(VBA.Mid$(sLine, iColumns(ii) + 1, iColumns(ii) - iColumns(ii - 1)))
                            Next ii

                            'Now do the last column
                            If VBA.Len(sLine) > iColumns(iNoColumns) Then
                                sAssets(iNoColumns + 1, iCount) = VBA.Trim$(VBA.Right$(sLine, VBA.Len(sLine) - iColumns(iNoColumns)))
                            End If
                        Else
                            'Reset the counter
                            iCount = 0
                        End If
                    End If
                End If

            End If
        End If
    Loop

    'Clean up
    fsFile.Close
    Set fsFile = Nothing
    Set fs = Nothing
End Sub
于 2013-02-24T08:03:39.537 に答える
0

PasteBinが削除されたため、サンプルデータを調べることができません。問題の説明から収集できることから、正規表現を使用するとデータの解析がはるかに簡単になるように思われます。

FileSystemObjectのスクリプトランタイムscrrun.dllへの参照を追加します。
MicrosoftVBScript正規表現5.5への参照を追加します。RegExpオブジェクトのライブラリ。

Dim objRE AsNewRegExpを使用してRegExオブジェクトをインスタンス化します

Patternプロパティを"(\ bd {4} \ b){1,3}"に設定します。上記のパターンは、次のような文字列を含む行と一致する必要があります:2010 2010 2011 2010 2011 2012

年の文字列間のスペースの数は、少なくとも1つある限り、関係ありません(たとえば、201020112012のような文字列に遭遇することは想定されていないため)

GlobalプロパティをTrueに設定します

キャプチャされたグループは、RegExオブジェクトobjREのExecuteメソッドによって返されるMatchCollectionの個々のMatchオブジェクトにあります。したがって、適切なオブジェクトを宣言します。

Dim objMatches as MatchCollection
Dim objMatch as Match
Dim intMatchCount 'tells you how many year strings were found, if any

FileSystemObjectオブジェクトを設定し、テキストファイルをスキャンして、各行を変数strLineに読み込むと仮定します。

現在の行に求められているパターンが含まれているかどうかを確認するための最初のテスト:

If objRE.Test(strLine) Then
  'do something
Else
  'skip over this line
End If

Set objMatches = objRe.Execute(strLine)
intMatchCount = objMatches.Count

For i = 0 To intMatchCount - 1
   'processing code such as writing the years as column headings in Excel
    Set objMatch = objMatches(i)
    e.g. ActiveCell.Value = objMatch.Value
   'subsequent lines beneath the line containing the year strings should
   'have the amounts, which may be captured in a similar fashion using an
   'additional RegExp object and a Pattern such as "(\b\d+\b){1,3}" for
   'whole numbers or "(\b\d+\.\d+\b){1,3}" for floats. For currency, you
   'can use "(\b\$\d+\.\d{2}\b){1,3}"
Next i

これは、私がこの課題にどのように取り組むかについての大まかな概要です。このコードの概要に、役立つものがあることを願っています。

于 2015-03-31T12:08:22.163 に答える
0

これを行う別の方法は、VBAを使用して.docまたは.docxファイルに変換し、Wordファイルからテーブルを検索してプルすることです。それらはExcelシートに簡単に抽出できます。変換はテーブルをうまく処理するようです。ただし、これはページごとに機能するため、ページにまたがるテーブルは、最終的にdocという単語の個別のテーブルになることに注意してください。

于 2019-04-26T17:52:16.213 に答える