| |
以前アドバイスをいただいて作成した、シフト表をリバイスしています。
ある程度自力でできましたが、できない点があります。
シフト表のF列には人の名が繰り返し出てきます。
その左隣のE列目に、次の規則にのっとって○をつけたいのです。
まず、E3,E11,E16,E21に○をつけます。
人ごとに表出回数をカウントし、F3,F11,F16,F21の人に１ポイント追加します。
次に、E26,E34,E39,E44に○をつけるのですがその際に、
F26に在る人名のカウントがF27に在る人名のカウントより大きかったら、E26でなくE27に○をつけ、
F34に在る人名のカウントがF35に在る人名のカウントより大きかったら、E34でなくE35に○をつけ、
F39に在る人名のカウントがF40に在る人名のカウントより大きかったら、E39でなくE40に○をつけ、
F44に在る人名のカウントがF45に在る人名のカウントより大きかったら、E44でなくE45に○をつけます。
そのように531行まで繰り返し、結果、人ごとのカウントが可能な限り均等になる
ようにしたいのですが、どのようなロジックを追加すればよいかわからず壁にぶつかっています。
どなたかご教示くださいませんでしょうか。
Sub test2()
Dim v As Variant
Dim lc As Long
Dim r As Long
Dim i As Long
Dim k As Long
Const lr As Long = 531
Dim rag As Range, FRw As Long
With ActiveSheet
If .Name = "営業日" Then
MsgBox "シフト表をアクティブにして実行する事。", 64
Exit Sub
End If
Application.ScreenUpdating = False
r = 3
i = 1
k = 1
m = 6
Do While r <= lr
Select Case False
Case r Mod 23 = 11 Or r Mod 23 = 16
v = Worksheets("人員").Range("A2:A30").Value
.Cells(r, 6).Value = v(i, 1)
i = i + 1
If i > 29 Then i = 1
r = r + 1
Case Else
v = Worksheets("人員").Range("B2:B5").Value
.Cells(r, 6).Value = v(k, 1)
k = k + 1
If k > 4 Then k = 1
r = r + 1
End Select
Loop
Application.ScreenUpdating = True
End With
End Sub
|
|
にしもり
- 05/6/29(水) 17:12 -
