こんばんは!
VBAになりますが、一例です。
元データはSheet1にあり、Sheet1の1行目はシリアル値になっているとします。
そして祝日データはSheet2に作成してあるという前提です。
標準モジュールに↓のコードをコピー&ペーストしてマクロを実行してみてください。
Sub 赤ライン()
Dim lastRow As Long, j As Long, c As Range, r As Range, myRange As Range, wS As Worksheet
Set wS = Worksheets("Sheet2")
With Worksheets("Sheet1")
.Lines.Delete
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For j = 2 To .Cells(1, Columns.Count).End(xlToLeft).Column
Set myRange = wS.Cells.Find(what:=.Cells(1, j), LookIn:=xlValues, lookat:=xlWhole)
If Not myRange Is Nothing Or WorksheetFunction.Weekday(.Cells(1, j), 2) > 5 Then
Set c = .Cells(3, j)
Set r = .Cells(lastRow, j)
With .Shapes.AddLine(c.Left + c.Width / 2, c.Top, r.Left + r.Width / 2, r.Top + r.Height).Line
.ForeColor.RGB = vbRed
.Weight = 3
End With
End If
Next j
End With
End Sub
※ データ変更があるたびにマクロを実行する必要があります。
尚、お使いのバージョンがExcel2010以降の場合は、条件付き書式でセルに色がついている場合の判断が可能です。
もしExcel2010以降の場合は↓のコードでも大丈夫だと思います。
(この場合祝日データは参照する必要はなく、Sheet1の3行目に色がついている場合に赤線が表示されます)
Sub Excel2010以降の場合()
Dim lastRow As Long, j As Long, c As Range, r As Range, wS As Worksheet
Set wS = Worksheets("Sheet2")
With Worksheets("Sheet1")
.Lines.Delete
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For j = 2 To .Cells(1, Columns.Count).End(xlToLeft).Column
If .Cells(3, j).DisplayFormat.Interior.ColorIndex <> xlNone Then
Set c = Cells(3, j)
Set r = Cells(lastRow, j)
With .Shapes.AddLine(c.Left + c.Width / 2, c.Top, r.Left + r.Width / 2, r.Top + r.Height).Line
.ForeColor.RGB = vbRed
.Weight = 3
End With
End If
Next j
End With
End Sub
こんな感じではどうでしょうか?m(_ _)m
お礼
ありがとうございました。 コードを参考にさせていただき、無事解決することができました。