web-dev-qa-db-ja.com

VBA（Excel）：ループのない複数の検索基準に基づいて検索

3セットの基準に基づいてVBAで検索したい大きなデータシートがあります。各行エントリは一意であると想定できます。シート/データ自体のフォーマットは、要件により変更できません。 （私は関連する質問についていくつかの投稿を見ましたが、これのための実用的な解決策をまだ見つけていません。）

最初に、古典的なVBA find メソッドをループで使用しました。

Set foundItem = itemRange.Find(What:=itemName, Lookin:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows)
If Not foundItem Is Nothing Then
    firstMatchAddr = foundItem.Address
    Do
        ' *Check the other fields in this row for a match and exit if found*
        Set foundItem = itemRange.FindNext(foundItem)
    Loop While foundItem.Address <> firstMatchAddr  And Not foundItem Is Nothing
End If

しかし、これは大量のデータセットで何度も呼び出す必要があるため、この速度は良くありませんでした。

検索を行ったところ、 match メソッドを index で使用できることがわかりました。だから私はそのような多くのバリエーションを試してみましたが失敗しました：

result = Evaluate("=MATCH(1, (""" & criteria1Name & """=A2:A" & lastRow & ")*(""" & criteria2Name & """=B2:B" & lastRow & ")*(""" & criteria3Name & """=C2:C" & lastRow & "), 0)")

そして

result = Application.WorksheetFunction.Index(resultRange, Application.WorksheetFunction.Match((criteria1Name = criteria1Range)*(criteria2Name = criteria2Range)*(criteria3Name = criteria3Range))

そして

result = Application.WorksheetFunction.Index(resultRange, Application.WorksheetFunction.Match((criteria1Range=criteria1Name )*(criteria2Range=criteria2Name )*(criteria3Range=criteria3Name ))

次に、 AutoFilter を使用してソートしました：

.Range(.Cells(1,1), .Cells(lastRow, lastCol)).AutoFilter Field:=1, Criteria1:="=" & criteria1Name
.Range(.Cells(1,1), .Cells(lastRow, lastCol)).AutoFilter Field:=2, Criteria1:="=" & criteria2Name
.Range(.Cells(1,1), .Cells(lastRow, lastCol)).AutoFilter Field:=3, Criteria1:="=" & criteria3Name

しかし、ソート列の1つに日付が含まれているため、オートフィルターを適切に機能させるのに問題がありました。

私の質問は、複数の基準に基づいてExcel VBAの列を検索するにはどうすればよいですかループせずに、行番号または値のいずれかを返します私が興味を持っているその行のセルに？

excel-vbasearchcriteriavbaexcel
7
user1205577

高度なフィルターを使用できます。列ヘッダーをシートの別の部分（または完全に別のシート）に配置します。それらの列見出しの下に、探している基準を各列に入力します。次に、その範囲（ヘッダーを含む）に「基準」のような名前を付けます。次に、マクロは次のようになります。

Sub Macro1()

    Sheets("Sheet1").Range("A1").CurrentRegion.AdvancedFilter xlFilterInPlace, Range("Criteria")

End Sub

以下の私のコメントのフォローアップとして、VBAに舞台裏で基準範囲を作成させるには：

Sub Macro1()

    'Code up here that defines the criteria

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    With Sheets.Add
        'Create the advanced filter criteria range
        .Range("A1") = "HeaderA"
        .Range("B1") = "HeaderB"
        .Range("C1") = "HeaderC"
        .Range("A2") = criteria1Name
        .Range("B2") = criteria2Name
        .Range("C2") = criteria3Name

        'Alternately, to save space:
        '.Range("A1:C1").Value = Array("HeaderA", "HeaderB", "HeaderC")
        '.Range("A2:C2").Value = Array(criteria1Name, criteria2Name, criteria3Name)

        'Then perform the advanced filter
        Sheets("Sheet1").Range("A1").CurrentRegion.AdvancedFilter xlFilterInPlace, .Range("A1:C2")

        'Remove behind the scenes sheet now that the filter is completed
        .Delete
    End With

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub
7
tigeravatar

EVALUATEを複数の基準に使用して、算術値の行番号を返すことができます。これは同じアプローチを使用します ループせずに特定の基準に一致する行番号を配列に入力することは可能ですか？

  • 一致する50000行を検索します
    • 列Aの最初の4文字はfredに一致します
    • bの日付が1/1/2001より大きい
    • Apple列5に
  • これらの基準に一致する行は、xの行番号として再調整されます

（下の画像の行1と5）

コード

Sub GetEm2()
x = Filter(Application.Transpose(Application.Evaluate("=IF((LEFT(A1:A10000,4)=""fred"")*(B1:B10000>date(2001,1,1))*(C1:C10000=""Apple""),ROW(A1:A10000),""x"")")), "x", False)
End Sub

Application.Transposeは65536セルに制限されているため、より長い範囲を細かく「チャンク」する必要があります。

enter image description here

5
brettdj