|
こんにちは。
以前、みなさまのおかげで以下のシフト表作成のプログラムを組みました。
いま新たな2要件がでてきました。
パターンIの人をr=12,13,24,25,36,37,48,49,60,61,72,73,84,85の場合はm=6から表出させたい、という要件です。
パターンIIの人をr=12,13,24,25,36,37,48,49,60,61,72,73,84,85の場合は表出させない、という要件です。
規則性はあると思うのですが私の実力不足でプログラムに反映できません。
どこを修正すればよいか、どなたかご教示ください。
Sub test2()
Dim v As Variant
Dim lc As Long
Dim r As Long
Dim m As Long
Dim i As Long
Const lr As Long = 90
Dim rag As Range, FRw As Long
'パターンI
v = Worksheets("人員").Range("A2:A30").Value
With ActiveSheet
If .Name = "人員" Then
MsgBox "シフト表をアクティブにして実行する事。", 64
Exit Sub
End If
Application.ScreenUpdating = False
r = 3
i = 1
Do While r <= lr
Select Case True
Case r Mod 4 = 3
lc = 20
m = 6
Case r Mod 4 = 0
lc = 14
m = 8
Case r Mod 4 = 1
lc = 14
m = 8
Case Else
lc = 14
m = 6
End Select
Do While m <= lc
.Cells(r, m).Value = v(i, 1)
i = i + 1
If i > 29 Then i = 1
m = m + 2
Loop
r = r + 1
Loop
Application.ScreenUpdating = True
End With
'パターンII
v = Worksheets("人員").Range("B2:B4").Value
With ActiveSheet
Application.ScreenUpdating = False
r = 4
i = 1
Do While r <= lr
Select Case True
Case r Mod 4 = 0
.Cells(r, 6).Value = v(i, 1)
i = i + 1
If i > 3 Then i = 1
r = r + 1
Case r Mod 4 = 1
.Cells(r, 6).Value = v(i, 1)
i = i + 1
If i > 3 Then i = 1
r = r + 3
End Select
Loop
Application.ScreenUpdating = True
End With
End Sub
|
|