番号を振るvbaで悩んでいます。

質問

本を読みながら作ったのですが、全然動いてくれません。

Sheet１に
A　　　　　　　　　　　B
1
2開始日　　　　　　2月12日
3開始時間　　　　 8:30
4終了時間　　　　　12:00
5間隔/ 分　　　　　　5
6人数/コマ　　　　　　8

という情報が入っています。
Sheet2には
A2から番号が振ってあります。2000件くらいあります。
それに次の条件で番号を振りたいのです。

8時30分から12時までの間で8人毎に5分間下記の時間を振り分けたいのです。
12時を過ぎると翌日の8時半からまた同じことを繰り返します。
Sheet1の情報は毎回変更しますので、変数を使いたいと思っています。
　　　　　A　　　　　B　　　　　C
1
2　　　　1001　　2/12　　　8:30
3　　　　1002　　2/12　　　8:30
:　　　　　　:　　　　:　　　　　　:
:　　　　　1008　　2/12　　　8:30
:　　　　　1009　　2/12　　　8:35
:　　　　　1010　　2/13　　　8:35
:　　　　　　:　　　　:　　　　　　:
:　　　　　　:　　　　:　　　　　　:
:　　　　　1336　　2/13　　　8:30
:　　　　　　:　　　　:　　　　　　:

Sub test()

Dim strdate As Date, strtime As TimeValue, endtime As TimeValue
Dim i As Long, c As Long, j As Long

strdate = Worksheets(2).Range("b2").Value
strtime = Worksheets(2).Range("b3").Value = TimeValue("8:30")
endtime = Worksheets(2).Range("b4").Value = TimeValue("12:00")
Range("b:b").NumberFormatLocal = "h:mm"

i = Worksheets(2).Range("b5").Value
c = Worksheets(2).Range("b6").Value

If strtime < endtime Then
Do While strtime < endtime
For j = 1 To c
Worksheets(1).Cells(j, 0) = strdate
Worksheets(1).Cells(j, 1) = strtime
Next j
strtime = DateAdd("m", 5, strtime)
Loop
Else
strtime = Worksheets(2).Range("b3").Value
Do Until strtime = endtime
For j = 1 To c
Worksheets(1).Cells(j, 0) = strdate + 1
Worksheets(1).Cells(j, 1) = strtime
Next j
strtime = strtime + 5
Loop
End If

End Sub

これでは全く動きませんでした。
また、strtimeをtimevalueで宣言するとオブジェクトを要求され、結果変数ではなく
直接データを入れることになってしまい、目的を果たせません。
初心者がやることではないなと思いましたが、これが出来ると、私たちの仕事が
画期的に向上するので、是非今回は苦労しても作り上げたいと思いました。
プロの方々はこういう場合、私はIf ⇒Do Loop⇒For Nextをネストしましたが、
どういう風に考えられるのでしょうか？それも興味があります。

よろしくアドバイスお願いします。<m(_　_)m>

回答No.1

ki-aaa · ベストアンサー

質問の意図を読み違えていなければいいのですが

標準モジュールに貼り付けて、実行してください。

Sub 時刻毎に8個作る()

Dim StrDate As Date, StrTime As Date, EndTime As Date
Dim wkDateTime As Date
Dim i As Long, c As Long, j As Long, Gyo As Long

Application.ScreenUpdating = False
StrDate = Sheets("Sheet1").Range("B2").Value '日付け
StrTime = Sheets("Sheet1").Range("B3").Value 'TimeValue("8:30")
EndTime = Sheets("Sheet1").Range("B4").Value 'TimeValue("12:00")
i = Sheets("Sheet1").Range("B5").Value '5
c = Sheets("Sheet1").Range("B6").Value '8

Sheets("Sheet2").Range("B:B").NumberFormatLocal = "m/d"
Sheets("Sheet2").Range("C:C").NumberFormatLocal = "h:mm"

Gyo = 2
j = 0
wkDateTime = StrDate + StrTime - TimeSerial(0, i, 0)

Do
If j Mod c = 0 Then
wkDateTime = wkDateTime + TimeSerial(0, i, 0)
End If
If TimeValue(wkDateTime) > StrTime - TimeValue("00:01") And _
TimeValue(wkDateTime) < EndTime + TimeValue("00:01") Then
Sheets("Sheet2").Cells(Gyo, "B").Value = DateValue(wkDateTime)
Sheets("Sheet2").Cells(Gyo, "C").Value = TimeValue(wkDateTime)
Gyo = Gyo + 1
End If
j = j + 1
Loop While Sheets("Sheet2").Cells(Gyo, "A").Value <> ""

Application.ScreenUpdating = True
End Sub

お礼

ki-aaaさん
早速の回答、有難うございました。
完璧！！でした。
日付と時間を使うことで、記述がちょっと複雑になりましたが、
それにしても、私には考え付かない方法で、戸惑っています。
どうしてこういう風に考えられるのか。。。
シンプルなのに。。。
どうしてもわからないので、教えてください。すみません。
なぜ、このような式が考えられるのでしょうか？

wkDateTime = StrDate + StrTime - TimeSerial(0, i, 0)

日付と時間と時間のシリアル値で、式が成り立つんですね。
私の発想では到底たどり着かない域です。
この部分もよくわかりません。

If TimeValue(wkDateTime) > StrTime - TimeValue("00:01") And _
TimeValue(wkDateTime) < EndTime + TimeValue("00:01") Then

って、殆どわかっていないっていう事ですよね。(^^;
変数ｊもよくわかりません。

頭の構造がもともと違うのか、
それとも構文をもっと理解して考え方のもとを変える必要があるのか。。。
あきらめた方がいいのかなぁ、vba。
う～ん、むずかしいです、vba。

でも、本当に助かりました。
今日から早速使ってみます。
遅い時間まで対応していただいた事に
心より感謝しています。
有難うございました！！
もし、質問に答えてくださったら、もっともっと感謝感謝です。
<m(__)m>

回答No.3

ki-aaa

質問にうまく答えられるかどうか。

>なぜ、このような式が考えられるのでしょうか？
>wkDateTime = StrDate + StrTime - TimeSerial(0, i, 0)
　↓
時間の計算については、"Excel シリアル値"で検索してください。

この式の時間計算で、 - TimeSerial(0, i, 0)してあるのは
次の繰り返しのコードで、最初に5分加算するようになっているので、
そのぶんを引いてあります。

>If j Mod c = 0 Then
>wkDateTime = wkDateTime + TimeSerial(0, i, 0)
>End If
　↓
この部分はJが0,8,16...のとき、つまり8回に一度加算するようにしています。

>If TimeValue(wkDateTime) > StrTime - TimeValue("00:01") And _
>TimeValue(wkDateTime) < EndTime + TimeValue("00:01") Then
　↓
この部分は、"8時30分から12時までの間で"両端含むの処理を、
これを"8時29分から12時01分までの間で"両端含まずの処理に変えてあります。

なぜこのような処理にしたかというと、
時間の比較の=(等号)で痛い目にあったので、
マイルールで、時間の比較は、大小比較(<,>)にしています。

上記の理由
エクセルのシートに入れた時間の表示形式を標準にする
その数値の一番下の桁の値をを変える
そのセルの表示形式を時間に変える
見た目は同じでも、実際は違う値になっている
このようなことは、オートフィルで時間を作っているとたまにある。

お礼

ki-aaaさん

お礼が遅くなってしまって、すみませんでした。
すぐに御礼をしたつもりがうまく登録されていなかったようです。

で、今もせっかく書いたお礼がまた消えてしまいました。（＾＾；

3度目はうまくいくでしょうか！！（^^；

シリアル値の計算は理解できました。

しかし5分おきのところは、発想がすごいです。説明を何度か読んでようやく作業内容が見えてきましたが、次回同じような状況に出会った時に、この発想を使うことができるか。何度か記述を書き出して、がんばって覚えています。

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

回答No.2

NotFound404

ご参考まで。

Sub test2()
Dim sDate As Date, sTime As Date, eTime As Date
Dim IntervalTime As Integer
Dim manNum As Integer
Dim c As Range
Dim i As Integer, j As Integer

sDate = Worksheets("sheet1").Cells(2, 2) '開始日 2月12日
sTime = Worksheets("sheet1").Cells(3, 2) '開始時刻 8:30
eTime = Worksheets("sheet1").Cells(4, 2) '終了時刻 12:00
IntervalTime = Worksheets("sheet1").Cells(5, 2) '間隔/分 5
manNum = Worksheets("sheet1").Cells(6, 2) '人数/コマ 8

Worksheets("Sheet2").Range("B:B").NumberFormatLocal = "m/d"
Worksheets("Sheet2").Range("C:C").NumberFormatLocal = "h:mm"

For Each c In Worksheets("sheet2").Range("A2", Worksheets("sheet2").Range("A2").End(xlDown))
If DateAdd("n", (i \ manNum) * IntervalTime, sTime) > eTime Then
i = 0
j = j + 1
End If

c.Offset(0, 1) = DateAdd("d", j, sDate)
c.Offset(0, 2) = DateAdd("n", (i \ manNum) * IntervalTime, sTime)
c.Offset(0, 3) = i '←↓理解用
c.Offset(0, 4) = i \ manNum 'i を mannum で割った商、Int(i / manNum) と同じ
i = i + 1
Next
End Sub

お礼

NotFound404 さん

時々インターネットで見かける名前ですね。^^
今日も、友人のHPで見ました！！

回答、有難うございました。
時間を加算するところの発想は私も本を読みながら試したところでした。上手く出来ませんでしたが・・・ーー；

8回ごとという部分はやはり商を使う方法を取られるのですね。
個々の部分は私が体得できるかどうか、問題が残ります。
が、
有難うございました。
わかりやすくて、とても参考になりました。