2

テキスト解析用の VBA コードを作成しましたが、実行時に問題が発生しました。Google で Excel 組み込み関数の使用に関するアドバイスを見つけましたが、実行時間は改善されませんでした。

これが私がVBAを使用する問題です。テキスト (平均して 1 つまたは 2 つの文) を含む ~30k セルのリストと 1k のキーワードのリストがあり、それらすべてに数値スコアがあります。30,000 個のセルごとに、セルに含まれるキーワードを確認し、見つかったキーワードのスコアの合計を計算したいと考えています。

これが、今すぐ簡単に言えば、問題にアプローチする私の方法です。

  • 30k のテキスト セルをループする

  • キーワードのループ

  • キーワードがテキスト セルにあるかどうかを確認し、ある場合はキーワードのスコアを追加します

また、組み込み関数の検索を使用してみました:

  • キーワードのループ

  • 30k のテキスト セルを含むシート全体でキーワードを検索する

  • キーワードが見つかったら、対応するセルにスコアを追加します。

実行時間に大きな変化はありませんでした。

以下に、最初のアプローチのコードを示します。

'Loop on all the 30k text cells
For i = 2 To last_textcell

    'loop on the number of different category of scores, setting intial scores to zero.
    For k = 1 To nb_score - 1
        Score(k) = 0
    Next k

    j = 2

    'loop on the 1k keywords        
    Do While j < last_keywords

            !search if the keyword is in the text cell
            If UCase(Sheets("DATA").Range("V" & i).Value) Like "*" & UCase(Sheets("Keywords").Range("A" & j).Value) & "*" Then

                'if the keyword is found, add the score of the keyword to the previous score
                For l = 1 To nb_score - 1
                    Score(l) = Score(l) + Sheets("Keywords").Range("B" & j).Offset(0, l - 1).Value
                Next l

            End If

            j = j + 1

    Loop

    'paste the score 
    For k = 1 To nb_categ - 1
        Sheets("DATA").Range("CO" & i).Offset(0, k - 1).Value = Score(k)
    Next k


Next i

パフォーマンスを向上させるためのヒントはありますか?

どうもありがとうございました！

4

2 に答える 2

0

2 つの最適化を提案します。

  1. テストを実行する前に、文とキーワードの両方のリストをメモリにロードします。これは、テストの反復ごとではなく、シートからデータを 1 回だけ要求することを意味します。

  2. InStr関数を with で使用してvbTextCompare、キーワードのインスタンスを検索します。

サンプル コードは次のとおりです。スコア関数コードを再挿入するためのスタブを残しました。

Option Explicit

Sub QuickTest()

    Dim wsKeywords As Worksheet
    Dim wsData As Worksheet
    Dim lngLastRow As Long
    Dim varKeywords As Variant
    Dim varData As Variant
    Dim lngSentenceCounter As Long
    Dim lngKeywordCounter As Long

    Set wsKeywords = ThisWorkbook.Worksheets("Keywords")
    Set wsData = ThisWorkbook.Worksheets("DATA")

    'get list of keywords in memory
    lngLastRow = wsKeywords.Cells(wsKeywords.Rows.Count, "B").End(xlUp).Row
    varKeywords = wsKeywords.Range("B2:B" & lngLastRow).Value

    'get data in memory
    lngLastRow = wsData.Cells(wsData.Rows.Count, "V").End(xlUp).Row
    varData = wsData.Range("V2:V" & lngLastRow).Value

    'your scoring setup code goes here
    '...

    'iterate data
    For lngSentenceCounter = 1 To UBound(varData, 1)
        'iterate keywords
        For lngKeywordCounter = 1 To UBound(varKeywords, 1)
            'test
            If InStr(1, varData(lngSentenceCounter, 1), varKeywords(lngKeywordCounter, 1), vbTextCompare) > 0 Then
                'you have a hit!
                'do something with the score
            End If
        Next lngKeywordCounter
    Next lngSentenceCounter

    'your scoring output code goes here
    '...

End Sub
于 2016-07-11T09:39:46.963 に答える