難問 VBA 今日の日付より前に対するイベント処理

いつもお世話になっております。
添付ファイルのように

1.担当　Ａ　Ｂ　Ｃ　Ｄ　がいます。
2.Ｂ列には　日付があります。

3.コマンドボタンを押下したら、
今日より前の日付なら、済としたいのです。

今は、オートシェイプで作っていますが、
特に指定はありません。

質問者からの補足コメント

• 

  初心者なので申し訳ございませんでした。
  おしえてくれませんでしょうか

  No.1の回答に寄せられた補足コメントです。 補足日時：2020/08/26 12:39

• 

  Dim R As Date
  Dim rR As Range
  Set rR = Range("B5", Cells(Rows.Count, "B").End(xlUp))
  If R <= Date Then
  If rR.Offset(, 1).Resize(, 4).Value <> "" Then
  rR.Offset(, 1) = "済"
  End If
  End If
  これだとエラーになります。
  教えていただきたいです。

    補足日時：2020/08/26 13:00

• 

  For Each rSheet In Range("B5", Cells(Rows.Count, "B").End(xlUp))
  
  If rSheet < Date Then
  rSheet.Offset(, 1) = "済"
  End If
  
  Next
  これだとうまくいきますが、
  都市の名前がきえてしまいます。
  
  しかもＣ列のみです

    補足日時：2020/08/26 13:10

• 

  いつもありがとうございます。
  なにか良い方法おしえてくれませんでしょうか
  For Each R In Range("B5", Cells(Rows.Count, "B").End(xlUp)).Resize(, 4)
  
  If R < Date And R.Offset(, 1).Value <> "" Then
  R.Offset(, 1).Resize(, 4) = R.Offset(, 1).Resize(, 4) & " <済>"
  End If
  Next
  どこが間違っているところおしえてくれませんでしょうか

  No.2の回答に寄せられた補足コメントです。 補足日時：2020/08/26 13:21

No.1 回答者： fujillin 回答日時： 2020/08/26 11:52

こんにちは

私が理解できていないのか、どこが『難問』なのかわかりません。

Ｂ列を順に調べて
　・今日より前の日付の行で
　・Ｃ～Ｆ列に値があれば
　・「済」マークを付ける
ということでできそうに思いますが、どこがわからないのでしょうか？

No.2 回答者： Qchan1962 回答日時： 2020/08/26 13:12

こんにちは、

コードは、べたに書けばそんなに難しいとは思えません。

rR.Offset(, 1).Resize(, 4)は、レンジ範囲なので　.Value <> ""は型エラーかと

値のあるセルを対象にするのなら、ループで回す方が簡単かな？
rR.Offset(, 1) = "済"　で良いなら、countifで数を取得するのも有かもしれないけれど、、

No.3 回答者： Qchan1962 回答日時： 2020/08/26 13:15

＞都市の名前がきえてしまいます。

rSheet.Offset(, 1) = "済"　？

rSheet.Offset(, 1) = rSheet.Offset(, 1) & " <済>" では？

No.4 ベストアンサー 回答者： Qchan1962 回答日時： 2020/08/26 13:32

セルの一つ一つに済みを付けると言う事ですかね

であれば、取敢えずループを増やした方が簡単かと
For Each、offsetは使っていませんが、、べたに書くとこんな感じかと、、（走り書きです）

Dim i As Long, j As Long
For i = 5 To Cells(Rows.Count, "B").End(xlUp).Row
If CDate(Cells(i, "B")) <= Date Then
For j = 3 To 6
If Cells(i, j).Value <> "" Then
Cells(i, j).Value = Cells(i, j).Value & " < 済み > "
End If
Next
End If
Next

違うアプローチ検討するのなら、参考に成るか分かりませんが、、

この回答へのお礼

ありがとうございます。
CDate いれると型が一致しないとメッセージ
でるので、外したら問題ありませんでした。

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

お礼日時：2020/08/26 13:41