VBAで検索する代わりに配列を使用して効率を向上させる方法

Question

Excelワークシートの情報を見つけるために使用する関数があります。 - キーは可変列にあります。 - 可変フィールドを検索できます スプレッドシートは通常100カラム未満ですが、検索するには数100〜100 000行のものがあります。最大のファイルでは、私が最適化しようとしている機能を約100万回使用することができます。

https://fastexcel.wordpress.com/2011/10/26/match-vs-find-vs-variant-array-vba-performance-shootout/

を読んで...と私たちの機能を使用し、検索（3回）を見つけた後、私は配列を使用してみました。

この

は私が

Function getInfo(Key As String, NameField As String, NameKey As String, WksName As String) As Variant 

On Error GoTo Error 

Dim iColumnKEY As Integer 
Dim iColumnFIELD As Integer 
Dim i As Integer 
Dim ListFields, ListKeys As Variant 

ListFields = Worksheets(WksName).Range("A1:ZZ1") 


i = LBound(ListFields, 2) 

'To identify which column contains the Key and which one contains the 
'information we are searching for 
Do While iColumnKEY=0 Or iColumnFIELD=0 
    If i > UBound(ListFields, 2) Then 
     getInfo = "//error\\" 

    ElseIf ListFields(1, i) = NameKey Then 
     iColumnKEY = i 
    ElseIf ListFields(1, i) = NameField Then 
     iColumnFIELD = i 
    End If 
i = i + 1 
Loop 

Dim iROW As Integer 

ListKeys = Worksheets(WksName).Columns(iColumnFIELD) 

i = LBound(ListKeys, 1) 
Do While iROW=0 
    If i > UBound(ListKeys,1) Then 
     getInfo = "//error\\" 

    ElseIf ListKeys(i,1) = Key Then 
     iROW = i 
    End If 
    i = i + 1 
Loop 

getInfo = Worksheets(WksName).Cells(iROW, iColumnFIELD) 

Exit Function 

Error: 
    getInfo = "//error\\" 

End Function 

コードが動作書いたコードですが、非常に遅いです。私は何をしているのですか？

現時点ではコードに表示されていませんが、画面の更新を自動で停止するようにしました。速度の違いは見られませんでした。これは、基本的なアルゴリズムが主な問題であることを示しています。

さらに、記事は2011年に掲載されました。配列は依然としてMatch/Findよりもはるかに高速ですか？

補足：最終的には、すべての単一キーに対して関数を呼び出す代わりに、バッチ内の一連のキーを検索するマクロを使用することをお勧めします。ループは、マクロのために一度だけ実行されるだろう、と行のためにのみDo_Whileは、すべてのキーのために実行されるだろうがこれは...最初に行うことを意味します。しかし、これは非常に短期間では選択肢ではありません。

ありがとうございました。どんな助けやアドバイスも大歓迎です。コードのどの部分が最も遅いが何であるかを調べるに

Answer 1

、あなたはTimerを使用することができます。

Dim t as Single 
t = Timer 
' part of the code 
Debug.Print CDbl(Timer - t) ' CDbl to avoid scientific notation 

.Value2の代わり.Valueを使用してビットを助ける必要があります。

ListFields = Worksheets(WksName).Range("A1:ZZ1").Value2 

キーを検索し、 2つの別々のループのフィールドは、比較が少なくなるため、少し速くする必要があります。また、私はそれが少し遅くまたは速くなるかどうかわからないけど、あなたも、多次元配列を反復処理することができます：あなたのコードで

Dim i As Integer, v ' As Variant 
i = 1 

For Each v in ListFields 
    If v = NameKey Then 
     iColumnKEY = i 
     Exit For 
    End If 
    i = i + 1 
Next 

Answer 2

あなたは、私がこれは何だと思いますiColumnKEY

を使用することはありません

Function getInfo(key As String, NameField As String, NameKey As String, WksName As String) As Variant 

    Dim keyCol As Variant, fieldCol As Variant, keyRow As Variant 
    Dim errMsg As String 

    getInfo = "//error\\" 

    With Worksheets(WksName) 
     With Intersect(.UsedRange, .Columns("A:ZZ")) ' <--| reference a range in passed worksheet cells belonging to columns "A" to "ZZ" from worksheet first used row to last used one and from worksheet first used column to last used one 
      MsgBox .Address 
      fieldCol = Application.Match(NameField, .Rows(1), 0) '<--| look for passed 'NameField' in referenced range 
      If IsError(fieldCol) Then 
       errMsg = " :field column '" & NameField & "' not found" 
      Else 
       keyCol = Application.Match(NameKey, .Rows(1), 0) '<--| look for passed 'NameKey' in referenced range 
       If IsError(keyCol) Then 
        errMsg = " :key column '" & NameKey & "' not found" 
       Else 
        MsgBox .Columns(keyCol).Address 
        keyRow = Application.Match(key, .Columns(keyCol)) '<--| look for passed 'key' in referenced range 'NameKey' column 
        If IsError(keyRow) Then 
         errMsg = " :key '" & key & "' not found in column '" & NameKey & "'" 
        Else 
         getInfo = .Cells(keyRow, fieldCol) '<--| get referenced range "item" 
        End If 
       End If 
      End If 
      If errMsg <> "" Then getInfo = getInfo & errMsg 
     End With 
    End With 
End Function