ray88’s diary

お仕事で困ったとき用の自分用の覚書

ExcelVBA 複数の条件に合致する行番号を取得する(2つ以上の列のセルの値に合致する行)

■参考URL
複数の条件に合う行番号を取得するには -行列 A列 B列 C列 D列- その他(Microsoft Office) | 教えて!goo

Sub テスト()
Dim i As Variant
     i = Evaluate("SUM((A1:A15=C1)*(B1:B15=D1)*ROW(A1:A15))")
     If i <> 0 Then
            MsgBox i
     Else
            MsgBox "該当のデータが見つかりません", vbExclamation
     End If
End Sub

■実践編
マクロツールブックのSheet1のB列、C列の値の組み合わせに合致する行を検索対象エクセルより取得します。
f:id:ray88:20200412143847p:plain
結果はイミディエイトウィンドウで確認
f:id:ray88:20200412143919p:plain
■コードはこちら
呼び出し元プロシージャ

Sub try()
    Dim bookPath As String      'ワークブックのパスを格納
    Dim wb As Workbook          '対象ワークブックを格納
    Dim toolBook As Workbook    'マクロツールブック
    Dim val1 As String          '検索値の文字列1
    Dim val2 As String          '検索値の文字列2
    Dim intResult As Integer    '戻り値の行数格納用
    Dim i As Integer    
    'マクロツールブックを変数に格納
    ThisWorkbook.Activate
    Set toolBook = ActiveWorkbook    
    '検索対象ブックを変数に格納
    bookPath = "C:\デスクトップ\テスト\テストフォルダ\集計フォルダ\集計.xlsx"
    Set wb = Workbooks.Open(bookPath)           
    'マクロブックのSheet1より検索値を取得
    For i = 3 To 4
        toolBook.Sheets("Sheet1").Activate
        val1 = Sheets("Sheet1").Cells(i, 2).Value
        val2 = Sheets("Sheet1").Cells(i, 3).Value
        val1 = Chr(34) & val1 & Chr(34)
        val2 = Chr(34) & val2 & Chr(34)
        'ログ出力
        Debug.Print val1
        Debug.Print val2
        '検索値と合致する対象行を取得
       intResult = fncGetInputRow(wb, val1, val2)
        'ログ出力
        Debug.Print intResult
    Next
End Sub

ファンクションプロシージャ

Function fncGetInputRow(wb As Workbook, val1 As String, val2 As String) As Long
'----------------------------------------------
'機能:2つの検索値に合致するセルの行数を返す
'引数1:検索対象のワークブックオブジェクト
'引数2:検索値の文字列1
'引数3:検索値の文字列2
'戻り値: 検索値の組み合わせに合致する行数
'----------------------------------------------
    Dim i As Variant            '行数格納用変数
    Dim strCalc As String       '計算式格納用
'----------------------------------------------
    '検索対象ブックを選択
    wb.Sheets("Sheet1").Activate
    '計算式の文字列を変数に格納
    strCalc = "SUM((B1:B15=" & val1 & ")*(C1:C15=" & val2 & ")*ROW(B1:B15))"
    'ログ出力
    Debug.Print strCalc
    '検索対象の行を検索
    i = Evaluate(strCalc)
    '検索対象業が見つかったら戻り値を返す
    If i <> 0 Then
            fncGetInputRow = i
     Else
            fncGetInputRow = 0
            MsgBox "該当のデータが見つかりません", vbExclamation
     End If
End Function