VBA(エクセル）処理のコードを教えて頂けますでしょうか。

下記添付画像でシートAとシートBが別シートで存在しております。
シートAの 3～5行目のB～L列　がシートBの9行目以降のB～L列（M列除く）と全く同じデータが存在すれば、シートBのB列（最初はB9セル）を任意の色で塗りつぶすVBAでのコードを教えて頂きたいです。
※下記では赤枠で囲っております。

因みに通常作業時はシートAは10件ほど、シートBは6,000件ほどあります。

質問者からの補足コメント

• 複数のモジュールを繋いでおりますので、なるべく短いコードを希望します。

    補足日時：2021/09/13 19:50

No.2 ベストアンサー 回答者： Qchan1962 回答日時： 2021/09/13 02:37

追加です

＞シートBは6,000件
データの内容にもよりますが、フィルタの方が早いかも
Dim shA As Worksheet, shB As Worksheet
Dim rngA As Range, rngB As Range
Dim k As Range, r As Range
Dim aryA, ary
Dim i As Integer, n As Long
Dim strKey As String
Set shA = Worksheets("シートA")
Set shB = Worksheets("シートB")
Set rngA = shA.Range("B3", shA.Cells(Rows.Count, 2).End(xlUp))
ReDim aryA(rngA.Count)
ReDim ary(rngA.Count)
For Each k In rngA
strKey = ""
For i = 0 To 10
strKey = strKey & k.Offset(, i).Text
Next
aryA(n) = strKey
ary(n) = k.Text
n = n + 1
Next
Application.ScreenUpdating = False
For n = 0 To UBound(aryA)
If IsEmpty(ary(n)) Then GoTo aaa
shB.Range("B9").AutoFilter 1, ary(n)
For Each r In shB.Range("B9", shB.Cells(Rows.Count, 2).End(xlUp)).SpecialCells(xlCellTypeVisible)
strKey = ""
For i = 0 To 10
strKey = strKey & r.Offset(, i).Text
Next
If aryA(n) = strKey Then
If rngB Is Nothing Then
Set rngB = r
Else
Set rngB = Union(rngB, r)
End If
End If
Next
Next
aaa:
shB.AutoFilterMode = False
If Not rngB Is Nothing Then rngB.Interior.Color = RGB(255, 255, 0)
Application.ScreenUpdating = True

この回答へのお礼

すごい丁寧に教えて頂きありがとうございました。

お礼日時：2021/09/13 19:49

No.1 回答者： Qchan1962 回答日時： 2021/09/13 00:14

こんばんは

変数名適当でべたコードです
Dim shA As Worksheet, shB As Worksheet
Dim rngA As Range, rngB As Range
Dim k As Range, r As Range
Dim aryA
Dim i As Integer, n As Long
Dim strKey As String
Set shA = Worksheets("シートA")
Set shB = Worksheets("シートB")
Set rngA = shA.Range("B3", shA.Cells(Rows.Count, 2).End(xlUp))
ReDim aryA(rngA.Count)
For Each k In rngA
strKey = ""
For i = 0 To 10
strKey = strKey & k.Offset(, i).Text
Next
aryA(n) = strKey
n = n + 1
Next
For n = 0 To UBound(aryA)
For Each r In shB.Range("B9", shB.Cells(Rows.Count, 2).End(xlUp))
strKey = ""
For i = 0 To 10
strKey = strKey & r.Offset(, i).Text
Next
If aryA(n) = strKey Then
If rngB Is Nothing Then
Set rngB = r
Else
Set rngB = Union(rngB, r)
End If
End If
Next
Next
If Not rngB Is Nothing Then rngB.Interior.Color = RGB(255, 255, 0)

検証して解らない所は補足で