[[20111217125635]]　『複数の条件が合うものを抽出したい』（HARU）　ページの最後に飛ぶ

『複数の条件が合うものを抽出したい』（HARU）

いつもお世話になっています。

教えて下さい。
下の様な表を作成しています。

毎日利用するリスト

A 　　　　 B 　　　　 C 　　　　 D

10 　　　200 　　　 3000

11 　　　 201 　　　 3001

12 　　　202 　　　 3002

チェックリスト

A 　　　　 B 　　　　 C 　　　　 D

10 　　　200 　　　3000 　　　 AAA

11 　　　 201 　　　3001 　　　 BBB

12 　　　 202　　　 3002 　　　 CCC

10 　　　 200 　　　 4000 　　　空白

チェックリストのDを毎日利用するリストに表示したいのですが、

チェックリストのAもBもCも合うものを表示したいのですが、

どのようにすればいいのでしょうか？

知恵をかしてください！

 Listの中でKeyの重複、照合のルール等を考えないで、
 単純に照合と言うだけならこんな事？

 Option Explicit

 Public Sub Sample()

    Dim i As Long
    Dim lngRows As Long
    Dim rngList As Range
    Dim rngResult As Range
    Dim vntData As Variant
    Dim vntResult() As Variant
    Dim vntKey As Variant
    Dim dicIndex As Object

    Dim strProm As String

    'Listの先頭セル位置を基準とする（データ先頭のセル位置）
    Set rngList = Worksheets("チェックリスト").Range("A1")

    '結果出力の先頭セル位置を基準とする（データ先頭列のセル位置）
    Set rngResult = Worksheets("毎日利用するリスト").Range("A1")

    'Dictionaryオブジェクトを取得
    Set dicIndex = CreateObject("Scripting.Dictionary")

    With rngList
        '行数の取得
        lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row + 1
        If lngRows <= 1 And IsEmpty(.Value) Then
            strProm = "データが有りません"
            GoTo Wayout
        End If
        '列データを配列に取得
        vntData = .Resize(lngRows + 1, 4).Value
    End With

    'Dictionaryにチェックリストを登録
    With dicIndex
        For i = 1 To lngRows
            'A,B,C列をタブを挟んで連結
            vntKey = vntData(i, 1) & vbTab _
                    & vntData(i, 2) & vbTab & vntData(i, 3)
            '照合KeyをKeyとしてD列を登録
            .Item(vntKey) = vntData(i, 4)
        Next i
    End With

    With rngResult
        '行数の取得
        lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row + 1
        If lngRows <= 1 And IsEmpty(.Value) Then
            strProm = "データが有りません"
            GoTo Wayout
        End If
        '列データを配列に取得
        vntData = .Resize(lngRows + 1, 3).Value
        '結果を格納する配列を確保
        ReDim vntResult(1 To lngRows, 1 To 1)
    End With

    '毎日利用するリストの先頭～最終行迄繰り返し照合
    With dicIndex
        For i = 1 To lngRows
            'A,B,C列をタブを挟んで連結
            vntKey = vntData(i, 1) & vbTab _
                    & vntData(i, 2) & vbTab & vntData(i, 3)
            '照合KeyがDictionaryに有ったなら
            If .Exists(vntKey) Then
                '結果用配列にD列を代入
                vntResult(i, 1) = .Item(vntKey)
            End If
        Next i
    End With

    '結果を出力
    With rngResult.Cells(1, 4).Resize(lngRows)
        .ClearContents
        .Value = vntResult
    End With

    strProm = "処理が完了しました"

 Wayout:

    Set dicIndex = Nothing
    Set rngList = Nothing
    Set rngResult = Nothing

    MsgBox strProm, vbInformation

 End Sub

 (Bun)

 こんな感じでどうでしょう？

 =INDIRECT("'チェックリスト'!d"&SUMPRODUCT((A2=チェックリスト!A2:A5)*(B2=チェックリスト!B2:B5)*(C2=チェックリスト!C2:C5)*ROW(チェックリスト!A2:A5)))

 (seiya)

コメント返信：

[ 一覧(最新更新順) ]

[[20111217125635]] 『複数の条件が合うものを抽出したい』（HARU） ページの最後に飛ぶ

[[20111217125635]]　『複数の条件が合うものを抽出したい』（HARU）　ページの最後に飛ぶ