行と列の交点を塗りつぶす

投稿者 : 初心者     投稿日時 : 2025/01/06(Mon) 18:19:11     OS : 未指定     EXCEL : 未指定

---

シートAの備考欄に「休み」がある場合、シートBの対象の名前と日付セルを黄色で塗りつぶしたいのですが、
マクロをご教授いただけないでしょうか？
よろしくお願いいたします。

シートA：https://ibb.co/qMRrVHs
シートB：https://ibb.co/VQfdjG5

投稿者 : てらてら     投稿日時 : 2025/01/06(Mon) 19:38:15

---

こんにちは。
前にも同じようなのがあったような,,,

シートAのA列とシートBの１行目が日付型でない場合はうまく行きません。
参照にしてください。

Sub macro()
    Dim i As Long, row As Long, col As Long
    
    Dim lastRow As Long
    lastRow = Worksheets("シートA").Cells(Rows.Count, 1).End(xlUp).row
    
    Dim lastRowB As Long
    lastRowB = Worksheets("シートB").Cells(Rows.Count, 1).End(xlUp).row
    Dim lastCol As Long
    lastCol = Worksheets("シートB").Cells(1, Columns.Count).End(xlToLeft).Column
    
    Dim myDate As Date
    Dim name As String
    
    For i = 3 To lastRow
        If Worksheets("シートA").Cells(i, "C") = "休み" Then
            myDate = Worksheets("シートA").Cells(i, "A")
            name = Worksheets("シートA").Cells(i, "B")
            For row = 3 To lastCol Step 2
                If Worksheets("シートB").Cells(row, "B") = name Then
                    For col = 4 To lastCol
                        If Worksheets("シートB").Cells(1, col) = myDate Then
                            Worksheets("シートB").Cells(row, col).Interior.Color = 65535
                            GoTo LABEL
                        End If
                    Next col
                End If
            Next row
LABEL:
        End If
    
    Next i
    
End Sub

投稿者 : 初心者     投稿日時 : 2025/01/07(Tue) 02:28:09

---

てらてら様。
ありがとうございます。
おかげさまでできました。
お礼申し上げます。