Excel VBAの繰り返し構文について

質問

A列に日付、B列に曜日、C列に休、D列に1直、E列に2直、という形の年間シフトを作成しています。
初期値としてA2セルに数字を入力→C列が空白の時だけD列に記入するマクロを作成したと思っています。

現在仮として、
Sub C列のセルが空白の行のD列に数値を入力()
下端行 = Range("A" & Rows.Count).End(xlUp).Row '下端検出
For 行 = 3 To 下端行 '1行目から下端行まで1行ずつ繰り返す
If Range("C" & 行).Value = "" Then 'その行のC列のセルの値が空白の時
Range("A2").Copy 'A2をコピーする
Range("D" & 行).PasteSpecial Paste:=xlPasteFormulas 'その行のA列のセルを起点に
'して数式を貼り付ける
End If
Next
End Sub

というマクロを置いていますが、「Range("A2").Copy」の部分を
「A2を初期値として、最初にC列が空白でなくなる時まで初期値を繰り返し、次にC列が空白になった場合は初期値+1の数をD列に入力する。
ただし初期値+1の最大数は6までとする（要するに1～6の繰り返しです）」
という感じに変更したいのですが、どうすればいいのかさっぱりです…。

VBAレベルはこの質問をする程度なのでかなり初級です。

回答No.3

don9don9 · ベストアンサー

私は
・休みをはさまない連続した出勤日をひとかたまりとして、全てに同じ番号を振る
・休みをはさんだ次の出勤日から、+1した番号を振る（ただし上限は6で、それを越えたら1に戻る）
・連続した休みもひとかたまりとする（2日連続で休みがあったとしても、その次の出勤日で+2されるわけではない）
という意味だと解釈した（一部勝手な憶測も混じっていますが）ので、なるべく元のコードを残す方向で以下のように修正してみました。
ご質問の意図を読み違えていたら申し訳ありません。

Sub C列のセルが空白の行のD列に数値を入力()
Dim 行 As Long
Dim 下端行 As Long
Dim 値 As Integer
値 = Range("A2").Value '初期値をA2セルの値とする
下端行 = Range("A" & Rows.Count).End(xlUp).Row
Range("D3:D" & 下端行).Value = "" 'D列を一旦クリアする
For 行 = 3 To 下端行
If 行 = 3 Then
'最初（3行目）のデータは、現在行が空白でない場合にカウントアップ
If Range("C" & 行).Value <> "" Then
値 = 値 + 1
End If
Else
'2番目（4行目）以降のデータは、一つ前の行が空白で、かつ現在行が空白でない場合にカウントアップ
If Range("C" & 行 - 1).Value = "" And Range("C" & 行).Value <> "" Then
値 = 値 + 1
End If
End If
'カウントアップした結果6を越えてしまった場合、1に戻す
If 値 > 6 Then
値 = 1
End If
If Range("C" & 行).Value = "" Then
Range("D" & 行).Value = 値
End If
Next
End Sub

お礼

あああ！！
ありがとうございます～！！
つたない質問文で的確な判断をしていただけて…。
まさにdon9don9さんのおっしゃる通りの作業がしたかったのです！！
書いていただいたコードをもう一度しっかり見直して、勉強させていただきます！！

他のお二方もアドバイスありがとうございました！

回答No.2

mu2011

一例です。

Dim 行 As Long, 直 As Integer, flg As Boolean
直 = Range("A2").Value - 1
flg = False
For 行 = 3 To Range("A" & Rows.Count).End(xlUp).Row
If Range("C" & 行).Value = "" Then
If flg = False Then 直 = 直 + 1: flg = True
Else
flg = False
Range("D" & 行) = 直 Mod 6 + 1
End If
Next

回答No.1

keithin

ふむ？
＞要するに1～6の繰り返しです

これは間違いで、＋０～＋６を繰り返すことにします。
わざわざマクロで繰り返し計算をしなくても、簡単に数式で求まります。

sub macro1()
　dim r as long
　r = range("A65536").end(xlup).row

　with range("D2:D" & r)
　　.formula = "=$A$2+MOD(COUNTBLANK($C$2:C2),7)"
　　.value = .value
　end with
end sub