VBAで複数の条件を照らし合わせセル内容を抜き取る

VBAで下記のような事がしたいです。

画像のように
B列に名前、D列に数字が入っています。

GからI列には
数字、内容、名前があります。

B列とI列、D列とG列をそれぞれ照らし合わせ
名前と数字が合致した時、H列の内容をE列の合致したセルに
表示したいというものです。

たとえば、E1セルにはH2セルの指導
E2セルにはH3セルの直接業務
E3セルにはH1セルの朝礼
・・・
といった感じです。

関数などではなくVBAが希望です。
宜しくお願いします。

No.1 ベストアンサー 回答者： tom04 回答日時： 2019/10/25 23:58

こんばんは！

お示しの画像のように項目行はなく、1行目からのデータだというコトで・・・
一例です。

Sub Sample1()
　Dim myDic As Object
　Dim i As Long, lastRow As Long
　Dim myStr As String
　Dim myKey, myR

　　Set myDic = CreateObject("Scripting.Dictionary")
　　　lastRow = Cells(Rows.Count, "G").End(xlUp).Row
　　　　myR = Range(Cells(1, "G"), Cells(lastRow, "I"))
　　　　　For i = 1 To UBound(myR, 1)
　　　　　　myStr = myR(i, 1) & "_" & myR(i, 3)
　　　　　　　If Not myDic.exists(myStr) Then '//←念のため//
　　　　　　　　myDic.Add myStr, myR(i, 2)
　　　　　　　End If
　　　　　Next i
　　　lastRow = Cells(Rows.Count, "A").End(xlUp).Row
　　　　myR = Range(Cells(1, "A"), Cells(lastRow, "E"))
　　　　　For i = 1 To UBound(myR, 1)
　　　　　　myStr = myR(i, 4) & "_" & myR(i, 2)
　　　　　　　If myDic.exists(myStr) Then
　　　　　　　　myR(i, 5) = myDic(myStr)
　　　　　　　Else
　　　　　　　　myR(i, 5) = ""
　　　　　　　End If
　　　　　Next i
　　　　Range(Cells(1, "A"), Cells(lastRow, "E")) = myR
　　　　　Set myDic = Nothing
　　　　　MsgBox "完了"
End Sub

こんな感じではどうでしょうか？m(_ _)m

この回答へのお礼

ありがとうございます。早急なご回答で非常に助かりました。
ありがとうございました。

お礼日時：2019/10/26 00:21