[[20250409091629]]　『開始～終了日付から矢印(オブジェクト)を記載する』（ヒマワリの種）　ページの最後に飛ぶ

『開始～終了日付から矢印(オブジェクト)を記載することはできないか？』（ヒマワリの種）

おはようございます。

現在、建築工事の進捗スケジュールを作成しています。
今まで手で作成していたのを、調べならが自動でできないか苦慮しています。

以下、マクロで開始～終了日を入力すると、矢印で予定を明示したく。
実行すると、

        startCol = foundCell1.Column ' 検索該当セルの列番号　　　←←←

で実行エラー91が出力。現在原因が分かっておりません。
原因および回避策をご教授いただけませんでしょうか。

カレンダー日付：U5～KB5まで
曜日　　　　　：U6～KB6まで
開始予定　　　：N7より縦100行ほど枠があり　※今後行が増える可能性あり
終了予定　　　：O7より縦100行ほど枠があり　※今後行が増える可能性あり
開始実績　　　：P7より縦100行ほど枠があり　※今後行が増える可能性あり
終了実績　　　：Q7より縦100行ほど枠があり　※今後行が増える可能性あり

上手く、WBSのイメージが伝えれていないかもしれませんが、
必要情報がありましたら、ご指摘ください。

どうか、よろしくお願い致します。

Sub 日付から矢印作成()

    Dim rng1 As Range
    Dim dt As Range
    Dim rng2 As Range
    Dim r As Long
    Dim foundCell1 As Range
    Dim startCol As Long
    Dim foundCell2 As Range
    Dim endCol As Long
    Dim targetRng As Range

    Set rng1 = ActiveSheet.Range(Range("U5"), Range("U5").End(xlToRight)) ' 日付入力範囲
    Set dt = ActiveSheet.Range("Q2") ' 今日の日付入力セル

    For Each rng2 In ActiveSheet.Range(Range("N7"), Range("N7").End(xlDown)) ' 開始日入力範囲
        r = rng2.Row ' 開始日・終了日入力セルの行番号
        Set foundCell1 = rng1.Find(rng2, , xlFormulas, xlPart) ' 開始日で検索した時の該当セル
        startCol = foundCell1.Column ' 検索該当セルの列番号　　　←←←
            If rng2.Offset(0, 1) = "" Then ' 終了日が空欄の場合
                Set foundCell2 = rng1.Find(dt, , xlFormulas, xlPart)  ' 今日の日付で検索した時の該当セル
                endCol = foundCell2.Column '検索該当セルの列番号
            Else ' 終了日が空欄ではない場合
                Set foundCell2 = rng1.Find(rng2.Offset(0, 1), , xlFormulas, xlPart) ' 終了日で検索した時の該当セル
                endCol = foundCell2.Column '検索該当セルの列番号
            End If
        ActiveSheet.Range(Cells(r, startCol), Cells(r, endCol)).Select
        Set targetRng = Selection ' 開始日から終了日までのセル範囲
        With ActiveSheet.Shapes.AddLine(targetRng.Left, targetRng.Top + targetRng.Height / 2, _
            targetRng.Left + targetRng.Width, targetRng.Top + targetRng.Height / 2).Line
            .ForeColor.RGB = RGB(255, 0, 0) ' 線の色
            .Weight = 3 ' 線の太さ
            .EndArrowheadStyle = 2 ' 線の終点のスタイル
        End With
    Next rng2

End Sub

＜使用 Excel：Microsoft365、使用 OS：Windows10 ＞

連投で申し訳ございません。

開始予定～終了予定が　青→
開始実績～終了実績が　赤→
のようなオブジェクトを描く方が、見やすいなどありましたら、
そちらでお願いしたく。

アドバイスよろしくお願い致します。
（ヒマワリの種） 2025/04/09(水) 10:09:10

原因の特定　--------

foundCell1 = rng1.Find(rng2, , xlFormulas, xlPart) の部分で、
rng2（開始日）が rng1（日付範囲）内で見つからない場合、
foundCell1 が Nothing になり、次の行で foundCell1.Column を呼び出すとエラーが発生します。

同様に、foundCell2 も同じように Find メソッドで該当するセルが見つからない場合、
Nothing になり、その後の処理でエラーが発生します。

回避策　------
Find メソッドの後に、該当するセルが見つかったかどうかをチェックし、
見つからなかった場合の処理を追加する必要があります。

もし該当するセルが見つからなかった場合に、
その処理をスキップしたり、エラーメッセージを表示するなどの対策を取ると良いです。

で修正後のコードとしては

Sub 日付から矢印作成()

    Dim rng1 As Range
    Dim dt As Range
    Dim rng2 As Range
    Dim r As Long
    Dim foundCell1 As Range
    Dim startCol As Long
    Dim foundCell2 As Range
    Dim endCol As Long
    Dim targetRng As Range

    Set rng1 = ActiveSheet.Range(Range("U5"), Range("U5").End(xlToRight)) ' 日付入力範囲
    Set dt = ActiveSheet.Range("Q2") ' 今日の日付入力セル

    For Each rng2 In ActiveSheet.Range(Range("N7"), Range("N7").End(xlDown)) ' 開始日入力範囲
        r = rng2.Row ' 開始日・終了日入力セルの行番号

        ' 開始日で検索
        Set foundCell1 = rng1.Find(rng2.Value, , xlFormulas, xlPart)
        If Not foundCell1 Is Nothing Then
            startCol = foundCell1.Column ' 検索該当セルの列番号
        Else
            MsgBox "開始日 " & rng2.Value & " は日付範囲に見つかりませんでした。", vbExclamation
            Exit Sub
        End If

        ' 終了日が空欄の場合、今日の日付を検索
        If rng2.Offset(0, 1).Value = "" Then
            Set foundCell2 = rng1.Find(dt.Value, , xlFormulas, xlPart)  ' 今日の日付で検索
            If Not foundCell2 Is Nothing Then
                endCol = foundCell2.Column ' 検索該当セルの列番号
            Else
                MsgBox "今日の日付 " & dt.Value & " は日付範囲に見つかりませんでした。", vbExclamation
                Exit Sub
            End If
        Else ' 終了日が空欄ではない場合
            Set foundCell2 = rng1.Find(rng2.Offset(0, 1).Value, , xlFormulas, xlPart) ' 終了日で検索
            If Not foundCell2 Is Nothing Then
                endCol = foundCell2.Column ' 検索該当セルの列番号
            Else
                MsgBox "終了日 " & rng2.Offset(0, 1).Value & " は日付範囲に見つかりませんでした。", vbExclamation
                Exit Sub
            End If
        End If

        ' 開始日から終了日までのセル範囲を選択
        ActiveSheet.Range(Cells(r, startCol), Cells(r, endCol)).Select
        Set targetRng = Selection ' 開始日から終了日までのセル範囲

        ' 矢印を追加
        With ActiveSheet.Shapes.AddLine(targetRng.Left, targetRng.Top + targetRng.Height / 2, _
            targetRng.Left + targetRng.Width, targetRng.Top + targetRng.Height / 2).Line
            .ForeColor.RGB = RGB(255, 0, 0) ' 線の色
            .Weight = 3 ' 線の太さ
            .EndArrowheadStyle = 2 ' 線の終点のスタイル
        End With
    Next rng2
End Sub

（暇な人） 2025/04/09(水) 10:22:02

 このあたりが参考になるかと思います。
http://officetanaka.net/excel/vba/tips/tips131b.htm
 数式ではなく、値を検索するとよいかも知れません。
（xyz） 2025/04/09(水) 10:24:12

質問者の提示されたコードで
日付入力が未入力と1行だとエラーになるが2行以上だとならない。
その違いは何でしょうね。
（趣味本位） 2025/04/09(水) 11:18:18

コメント返信：

[ 一覧(最新更新順) ]

[[20250409091629]] 『開始～終了日付から矢印(オブジェクト)を記載する』（ヒマワリの種） ページの最後に飛ぶ

[[20250409091629]]　『開始～終了日付から矢印(オブジェクト)を記載する』（ヒマワリの種）　ページの最後に飛ぶ