VBA指定した日付に条件が合えば文字を入れたい

質問

おはようございます。

すいませんが行き詰りましたので
皆様にご教授お願い致します。

やりたいこと

sheet１シート内の情報
B2:CB2セルまで日付が入っています。
（B2には3/1、C2には3/2と連続して日付が入っています。）
B3:CB3セルまで空白行が有ります。
B4:CB4セルまでどれかに”平日”という文字が有ります。

sheet2シート内の情報
E4:AI4セルに数字
（E4は1、F4は2・・・AI4は31と順番に数字が入っています。）
E5:AI5セルには、空白行が有ります。

この中で
もし、sheet1のB2:CB2セルまでの間で3/から始まる文字列が有り
B3:CB3セルまでの間で""空白が有り
B4:CB4セルまでの間で"平日"という文字が有れば
（すべての条件が合えば）

E4:AI4の数字に合うセル
例：3/1ならE4セルが１なのでE５セルに”勤務という文字”
　　3/5ならI4セルが５なのでI５セルに”勤務という文字”
　　3/31ならAI4セルが３１なのでAI５セルに”勤務という文字”
を入れていきたいのですが

下記コードでは
sheet１のB2セルに3/1があったときのみには
sheet2のE5セルに”勤務”という文字が入るのですが

実現したいのは
例えば、sheet１のD2セルに3/1から始まっても
E5セルに”勤務”と反映させたいです。

このコードでは、D2セルから3/1、E2セルに3/2という形だと
sheet2のG5セルとH5セルに”勤務”と入ってしまいます。

変数ｋの値をいちいち変更したら
希望通りに動くのですが
出来れば、変数kの値を変更させないように
うまくsheet1のB2:CB2のどれかに日付が入っても
sheet2のE5:AI5の位置に条件が合えば”勤務”っていう文字を
入れたいです。

何回やってもわからなかったため
すいませんがコード記載していただけますと
大変助かります。

回答よろしくお願いします。

Sub test()

Dim ws1 As Worksheet
Set ws1 = Worksheets("Sheet1")
Dim ws2 As Worksheet
Set ws2 = Worksheets("Sheet2")

For k = 2 To 80
If ws1.Cells(2, k).Value Like "3/*" Then 'もし、(sheet1)シートのB2：CB2セルまでの間で3/から始まる文字列が有れば
If ws1.Cells(3, k).Value = "" Then 'もし、B3:CB3セルまでの間で""空白が有れば
If ws1.Cells(4, k).Value = "平日" Then 'もし、B4:CB4セルまでの間で"平日"という文字が有れば

ws2.Cells(5, k + 3).Value = "勤務" '

End If
End If
End If
Next k

End Sub

回答No.2

kkkkkm · ベストアンサー

現状2行目はエクセルの日付データではなく普通の文字列だと思いますが、エクセルの日付データにすれば、以下のようになります。

For k = 2 To 80
If Month(ws1.Cells(2, k).Value) Like 3 Then 'もし、(sheet1)シートのB2：CB2セルまでの間で3月ならば
If ws1.Cells(3, k).Value = "" Then 'もし、B3:CB3セルまでの間で""空白が有れば
If ws1.Cells(4, k).Value = "平日" Then 'もし、B4:CB4セルまでの間で"平日"という文字が有れば
ws2.Cells(5, "E").Offset(0, Day(ws1.Cells(2, k).Value) - 1).Value = "勤務" '
End If
End If
End If
Next k

お礼

ありがとうございます！
確かに２行目を日付データになっていれば
理想の動きができました。

ちなみに時間が有れば教えていただきたいのですが
２行目の日付は3/1（水）みたいに曜日も交じっている場合
は3/1に日付データに変換できるのでしょうか？

回答No.3

kkkkkm

> ２行目の日付は3/1（水）みたいに曜日も交じっている場合
> は3/1に日付データに変換できるのでしょうか？

3/1と入力してから

書式設定の表示形式→ユーザー設定で
m/d(aaa)
として右にコピーしてください。

締め切られたのでサポート経由で回答しています。

お礼

回答ありがとうございます。

一度試してみます！
ありがとうございます！

回答No.1

kkkkkm

以下で試してみてください。3/1の文字列を探してB列からの差を最後にオフセットします。

If ws1.Cells(2, k).Value Like "3/*" Then 'もし、(sheet1)シートのB2：CB2セルまでの間で3/から始まる文字列が有れば
If ws1.Cells(2, k).Value Like "3/1*" Then
mCol = ws1.Cells(2, "B").Column - ws1.Cells(2, k).Column
End If
If ws1.Cells(3, k).Value = "" Then 'もし、B3:CB3セルまでの間で""空白が有れば
If ws1.Cells(4, k).Value = "平日" Then 'もし、B4:CB4セルまでの間で"平日"という文字が有れば
ws2.Cells(5, k + 3).Offset(0, mCol).Value = "勤務" '
End If
End If
End If