プロが教える店舗&オフィスのセキュリティ対策術

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

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

「VBA(エクセル)処理のコードを教えて頂」の質問画像

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

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

      補足日時:2021/09/13 19:50
gooドクター

A 回答 (2件)

追加です


>シート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
    • good
    • 0
この回答へのお礼

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

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

こんばんは


変数名適当でべたコードです
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)

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

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング