日付で矢印マクロ

これ実行時エラー91になってしまうのですがなぜですか？


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("C6"), Range("C6").End(xlToRight)) ' 日付入力範囲
Set dt = ActiveSheet.Range("B4") ' 今日の日付入力セル

For Each rng2 In ActiveSheet.Range(Range("A8"), Range("A8").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

No.4 回答者： Qchan1962 回答日時： 2023/07/26 10:20

＃２です　少し補足します

＞これ実行時エラー91になってしまうのですがなぜですか？
については先に回答していますが、おそらくエラーを回避しても問題は解決できないように思われます（＃３様がコードを書いているので解決できるかもしれませんが）

見方を変えて回答しますと
比較的簡単な表組で入力値も見渡せ間違えが無さそうなのに　
何故　Findで見つからないのか・・を考えてみてください

想像として
D6セルに =C6+1 のような数式でフィルしているような事ではないかと

ご質問を斜めから見た回答ですので説明は割愛して参考サイトで

http://officetanaka.net/excel/vba/tips/tips131b. …

https://www.moug.net/tech/exvba/0050163.html

この回答へのお礼

ありがとうございます！！

お礼日時：2023/07/29 10:27

No.3 回答者： fujillin 回答日時： 2023/07/25 22:41

こんばんは

＞これ実行時エラー91になってしまうのですがなぜですか？
ご提示のコードが、想定以外の状況を考慮していないからではないかと。
動作できる条件範囲内で利用すれば、一応動作するものと思います。

すでに、No1、No2様のご指摘にもありますが、
　・Findメソッドで該当セルが見つからない場合
は想定されていないと思われます。
その他にも、
　・A列のデータが8行目のみ、あるいは何もない場合
　・B4セルが空白などの場合（←起こり得るのか不明ですが）
等も想定はされていないようです。


シートの状態の説明やなさりたいことの説明がないので、コードからしか推測できませんけれど、勝手に妄想して作成してみたものが以下です。
ご参考にでもなれば。

Sub test()
Dim rng As Range
Dim Rstart As Range, Rend As Range
Dim Cstart, Cend
Dim n As Long
Dim x As Double, y As Double

n = Cells(6, Columns.Count).End(xlToLeft).Column - 2
Set rng = Range("C6").Resize(, Application.Max(1, n))

For n = 8 To Cells(Rows.Count, 1).End(xlUp).Row
Cstart = Cells(n, 1).Value
Cend = Cells(n, 2).Value
If Cend = "" Then Cend = Range("B4").Value

If Cstart <> "" And Cend <> "" Then
Set Rstart = rng.Find(Cstart, , xlValues, xlPart)
Set Rend = rng.Find(Cend, , xlValues, xlPart)
If Not (Rstart Is Nothing Or Rend Is Nothing) Then
x = Rend.Left + Rend.Width
y = Cells(n, 1).Top + Cells(n, 1).Height / 2
With ActiveSheet.Shapes.AddLine(Rstart.Left, y, x, y).Line
.ForeColor.RGB = RGB(255, 0, 0)
.Weight = 3
.EndArrowheadStyle = 2
End With
End If
End If
Next n
End Sub

この回答へのお礼

ありがとうございます！！

お礼日時：2023/07/29 10:28

No.2 回答者： Qchan1962 回答日時： 2023/07/25 17:02

何処でエラーが返っているか分かりませんが

可能性のある部分はざっくり見て複数あります

Range型変数にオブジェクトが上手くセット出来ず　Nothing　になっている時にそのRangeオブジェクトのプロパティを参照している所

例えばここ
Set foundCell1 = rng1.Find(rng2, , xlFormulas, xlPart) ' 開始日で検索した時の該当セル
startCol = foundCell1.Column ' 検索該当セルの列番号

Findメソッドで見つからなかった場合
foundCell1はNothingなので
startCol = Nothing.Column　は91エラー

対策として
Set foundCell1 = rng1.Find(rng2, , xlFormulas, xlPart) ' 開始日で検索した時の該当セル
If Not foundCell1 Is Nothing Then
startCol = foundCell1.Column ' 検索該当セルの列番号
Else
MsgBox "開始日の該当セルが見つかりません"
Exit Sub
End If
などが考えられます
これは　 終了日で検索した時の該当セル　に対しても言える事です

No.1 回答者： chiune 回答日時： 2023/07/25 17:00

アクティブシートの　C6 B4 A8 セルには適切な値が入っていますか？

※特にC6セル