excel vba で教えてください。 シートA、シートBがあります。

画像

Visual Basic | Excel21閲覧

ベストアンサー

0

ThanksImg質問者からのお礼コメント

本当にありがとうございました。

お礼日時:7/23 18:40

その他の回答(1件)

0

こんな感じになります。 Sub test02() Dim wsA As Worksheet Dim wsB As Worksheet Dim j As Long Dim dic As Object Dim w As String Dim rng As Range Dim x Set dic = CreateObject("Scripting.Dictionary") Set wsA = Worksheets("Aシート") Set wsB = Worksheets("Bシート") j = wsB.Cells(Rows.Count, 1).End(xlUp).Row x = wsB.Range("a2:b" & j).Value For j = 1 To UBound(x) w = Format(x(j, 1), "yyyymmdd") w = w & vbTab & x(j, 2) dic(w) = "" Next j Set rng = wsA.Range("h1") j = wsA.Cells(Rows.Count, 1).End(xlUp).Row x = wsA.Range("b2:c" & j).Value For j = 1 To UBound(x) w = Format(x(j, 1), "yyyymmdd") w = w & vbTab & x(j, 2) If dic.exists(w) Then 'dic(w)が存在する Set rng = Union(wsA.Cells(j + 1, 1).Resize(, 6), rng) End If If dic.exists(w) = False And rng.Areas.Count >= 10 Or _ j = UBound(x) And rng.Areas.Count >= 2 Then '着色 Intersect(wsA.Range("a:f"), rng).Interior.Color = vbYellow Set rng = wsA.Range("h1") End If Next j End Sub