当番表を作りたいです

質問

当番は1日一人で、それぞれ出勤日数が違うのですが、回数は公平になるようにしたいです。(出勤日が一人の場合は必然的に出勤者が当番)VBAではどのようにすれば良いでしょうか。平日のみの勤務です。

回答No.7

SI299792

実行速度を上げる為、プログラムを修正しました。日数が増えると差が出ます。
ついでにコメントもいれました。
前のプログラムは、人が連続しないようにしようとして（成功していないが）余計な部分があります。廃棄して下さい。
’
Option Explicit
'
Sub Macro1()
'
　　Const Member = 4
　　Dim Row As Long　　　　　　　　　　'行
　　Dim Col As Integer　　　　　　　　 '列
　　Dim Min As Integer　　　　　　　　 '当番最小値
　　Dim MinCol As Integer　　　　　　　'当番最小値の列
　　Dim Dutys(Member - 1) As Integer　 '各人の当番回数
'　 Ｆ列を消す
　　Row = [A1].End(xlDown).Row - 1
　　Cells(2, Member + 2).Resize(Row).ClearContents
'　 行の終了を探し、その１つ上まで繰り返す
　　For Row = 2 To Row
　　　　Min = 32767
'　　　 列を人数分繰り返す。
　　　　For Col = 2 To Member + 1
'　　　　　 出勤者の中で、当番の１番少ない人を選ぶ
　　　　　　If Cells(Row, Col) = "○" And Min > Dutys(Col - 2) Then
　　　　　　　　Min = Dutys(Col - 2)
　　　　　　　　MinCol = Col
　　　　　　End If
　　　　Next Col
'　　　 当番がいれば、当番をＦ列に表示、
　　　　If Min < 32767 Then
　　　　　　Cells(Row, Member + 2) = Cells(1, MinCol)
　　　　　　Dutys(MinCol - 2) = Dutys(MinCol - 2) + 1
　　　　End If
　　 Next Row
End Sub

回答がごちゃごちゃになってしまいました。どうして回答削除機能がないんだ！

回答No.6

SI299792

間違いが、
　　　　　　Cells(Row, Col + 5) = CountIf
はデバックの為につけたもので、不要です。
シートに余計なものが出るので外して下さい。

回答No.5

SI299792

人数は固定ですか。作る前に確認すればよかった。
私としては、同じ人が連続することがあり、不満なのですが。
コメントを表示とは、プログラムにコメントを入れてほしいということでしょうか。約束はできませんが、暇があればやってみます。

回答No.4

SI299792

作ってみました。A1に「日付」など、なんか入れて下さい。1行目の個数－２で人数を判断しています。
　ほほ同じ回数にすることはできましたが、同じ人が連続で入る事があるという問題があります。出勤したけど当番にしたくない日は●にするなど、運用で対応して下さい。
　問題は人の増減があった時です。人が減った時は削除するしかありません。人が増えた時、当然そのままでは、新人は今まで掃除していなかったので、ずっと新人の登板になります。それを防ぐには、今までの結果を削除するか、新人に適当に○を付けて、掃除したことにするかです。
'
Option Explicit
'
Sub Macro1()
'
　　Dim Member As Integer
　　Dim Row As Long
　　Dim Col As Integer
　　Dim CountIf As Integer
　　Dim Min As Integer
　　Dim MinCol As Integer
　　Dim What As String
　　Dim Find As Range
'
　　Member = [A1].End(xlToRight).Column - 2
'
　　For Row = 2 To [A1].End(xlDown).Row - 1
　　　　Set Find = Cells(1, Member + 2).Resize(Row - 1)
　　　　Min = 32767
'
　　　　For Col = 2 To Member + 1
　　　　　　What = Cells(1, Col)
　　　　　　CountIf = WorksheetFunction.CountIf(Find, What)
　　　　　　Cells(Row, Col + 5) = CountIf
'
　　　　　　If Cells(Row, Col) = "○" And Min > CountIf Then
　　　　　　　　Min = CountIf
　　　　　　　　MinCol = Col
　　　　　　End If
　　　　Next Col
'
　　　　If Min < 32767 Then
　　　　　　Cells(Row, Member + 2) = Cells(1, MinCol)
　　　　Else
　　　　　　Cells(Row, Member + 2).ClearContents
　　　　End If
　　 Next Row
End Sub

　同じ人が連続で掃除する件は、もう少し考えてみます。プログラムはものすごく複雑になりそうな気がします。

お礼

ひゃー！！すごい！！完璧じゃないですか！人数の増減は無いのでこれで完璧です！もし、もし、大丈夫なら、お手数で恐縮ですが、コメントを表示していただけないでしょうか。

回答No.3

imogasi

VBAでやりたいとして、
そのそこに盛り込む、仕様やロジックを（まず文章で）表現できないとダメだろう。考えてみたのか？
これはエクセル関数やVBAを知っているということとは別の能力で、質問者の日ごろの頭の想像力が試される問題だ。
また当社のニーズや慣習や状況は、関係者や質問者じゃないと正確にとらえられないものだ。だから回答は難しいのだ。例えばBさんは育児中で、外してほしい
など、あるよね。こういう例外的なことを真剣に考えないと、やわな質問と回答だと、振っとんじゃう。
質問者自身は内容的にどう考えたのか？
ーー
下記を批判してみて。
私の案（VBAコードを考える前に）
第2行から下に毎行処理する。
（１）当番は１日１人
（２）休日はスキップ
（３）当日出勤者をリスト（出勤者以外は、当番にしないらしいから）を作る。
（４）出勤者が１人の場合は、その人が当番(わざわざ当番のために会社に
出ない）
（５）過去の当番実績回数管理表を作っておく。
例　H2:L3に設けるとする。
そして過去の当番回数が最小（ただし同数なら左列の人を当番にする。
（６）その人の当番回数管理表のその列のセルを＋１増やす。
ーー
上記をコード化するには、VBAスキル的には、当日出席者だけの、過去当番回数実績回数をH2:L3から、引いてくるコードが必要になる（私ならFindを使う）。
ーー
関数での回答が出るかもしれないが、まあ本件はVBA処理問題だろうね。

回答No.2

msMike

》 VBAではどのようにすれば良いでしょうか
参考までに、貴方自身の VBA の知識はどの程度？

補足

初心者です。よろしくお願いいたします。

回答No.1

kkkkkm

勤務日数÷人数=当番回数(余った日はどうするのかわからないけど)
Aさん
当番回数-Aさんしか出勤していない日=残りの当番回数
Aさんしか出勤していない日を当番として記載
Aさんの出勤日の上から順に(上記記載日を飛ばして)残りの当番回数分割り当てる
以降BさんCさん…と