エクセルで当番表をつくりたいのですが、簡単な関数を使ってできません。私

質問

エクセルで当番表をつくりたいのですが、簡単な関数を使ってできません。私のレベルは中級くらいです。当番表の内容は、２１名がそれぞれ所有する田んぼの面積に応じて田んぼの水を入れる当番です。当番は二人一組で、行います。面積の広い人は、回数が多く、少ない人は回数が少なくあたるようにします。公平なものにならなくてはいけません。３～４か月間の毎日です。同じ面積の人も１０名位いるので、私は、全体面積に対する割合を出して、間隔日数を出す。後・・それぞれの割当たる間隔日数を崩さずに当たるようにする。・・・などあるのですが、・・私には、難しいので、どうかそんなの簡単だと思われる方は、至急回答お願いします。できたら、私でも理解しやすい表現で回答いただけたら、うれしいです。よろしくお願いします。

回答No.5

soixante · ベストアンサー

＃４です。以下貼り付けください。
Sub Toban()
Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet, Rng As Range
Dim r As Integer, c As Integer, p As Long, q As Long
Set Ws1 = Worksheets("Sheet1")
Set Ws2 = Worksheets("Sheet2")
Set Ws3 = Worksheets("Sheet3")
Ws1.Select
Set Rng = Cells(1, 1).CurrentRegion
With Rng
.Copy
.PasteSpecial Paste:=xlPasteValues
.Sort _
Key1:=Cells(1, 3), _
Order1:=xlDescending, _
Header:=xlNo, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
Sortmethod:=xlPinYin
End With
For r = 1 To 21
For c = 1 To Cells(r, 3)
Cells(r, c + 3).Value = Cells(r, 1) & c
Next c
Next r
Ws2.Select
Dim Hiduke As Date
Hiduke = InputBox("開始日入力。yyyy/m/d")
q = 0
For p = 0 To 178 Step 2
Range(Cells(1 + p, 1), Cells(2 + p, 1)).Value = Hiduke + q
q = q + 1
Next p
q = Ws1.Cells(1, Columns.Count).End(xlToLeft).Column
For p = 4 To q
Range(Ws1.Cells(1, p), Ws1.Cells(Rows.Count, p).End(xlUp)).Copy
Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll
Next p
Cells(1, 2).Delete
Set Rng = Cells(1, 1).CurrentRegion
For p = 0 To 89
Cells(p + 1, 4).Value = Cells(1, 1) + p
Cells(p + 1, 5).Value = Application.WorksheetFunction.VLookup(Cells(p + 1, 4), Rng, 2, 0)
Cells(p + 1, 6).Value = Application.WorksheetFunction.VLookup(Cells(p + 1, 4), Rng, 2, 1)
Next p
Set Rng = Cells(1, 4).CurrentRegion
Range(Cells(1, 4), Cells(1, 4).End(xlDown)).Copy Ws3.Cells(3, 1)
Range(Ws1.Cells(1, 1), Ws1.Cells(21, 2)).Copy
Ws3.Cells(1, 2).PasteSpecial Transpose:=True
Ws3.Select
Range(Columns(2), Columns(22)).ColumnWidth = 6
Dim Ret As Integer
For r = 1 To 90
For c = 5 To 6
Ret = Application.WorksheetFunction.Match(Left(Ws2.Cells(r, c), 1), Ws3.Rows(1), 0)
With Ws3.Cells(r + 2, Ret)
.Value = "■"
.HorizontalAlignment = xlCenter
End With
Next c
Next r
Set Ws1 = Nothing
Set Ws2 = Nothing
Set Ws3 = Nothing
End Sub

お礼

新しいブックで試したところできました。感激です。
ただ、わけもわからずあっという間にできてしまったので、
マクロの内容を是非、おしえてください。
会で、説明を聞かれたときに、ある程度は説明できるようにしておきたいと思います。
私の能力じゃないことは、歴然としているので、こんなことができるひとがいる・・ということも
伝えておきたいとおもいます。
手間だと思いますが、こんな機会はめったとないので、どうかよろしくお願いします。

最後の回数の少ない人が、後半でよく当たるのは、どうにかならないか、考えます。
もし、ＳＯＩＸＡＮＴＥさんも思いつくようでしたら、お願いします。３か月以上の悩みが一発解決です。
ありがとうございました。
厚かましく、説明もよろしくお願いします。

補足

ありがとうございます。・・でもチンプンカンプンです。是非是非ためしてみたいのですが・・・
こんなわたしでもこの内容が理解できますように、説明していただけたら、うれしいのですが・・・・
一刻もはやく内容をためしてみたく、わくわくしています。どうかよろしくおねがいします。

回答No.6

soixante

４，５の回答者です。

一度お試しいただければと思います。

ただし、21名の負担回数に極端に差がある場合など、うまく出ないこともありますので、その場合はご容赦ください。

補足

【４】からすすみません。実行するには同じ大きさのセル（シート）？が必要です。と出てしまいます。
何が原因でしょうか？

これが完成したら、このマクロの説明を是非ききたいです。

回答No.4

soixante

やはり機械的に処理するのには無理がありそうです。
最多回数の人、最少回数の人、それぞれの比率などによっても変わってしまいます。最後は手作業で鉛筆ナメナメ調整が要ると思います。
私ならどうするかといろいろ考えましたが、回数も平等に、間隔もほぼ平等に、とするために以下を思いつきました。
まずタタキ台を作ってみますかね。
やっぱりマクロが要りますね。

【１】Sheet1　の　Ａ１セルに　=CHAR(ROW(A65)) と入れ、下にＡ２１まで引っ張る。Ｂ１～Ｂ２１には21名の名前を書く。順不同。五十音順でもいいでしょう。

【２】Ｃ１～Ｃ２１にそれぞれの負担回数を入力。

【３】Alt+F11 。Microsoft Visual Basic という画面が出ます。
Alt+I、M　とすると、真っ白な画面が出ますから、のちほどご提示するコードをコピーして、その真っ白画面に貼ってください。

【４】エクセル画面に移り、Alt+F8、「Toban」を選択して実行。

【５】実行すると日付を聞かれますので、入力。yyyy/m/d方式で、水を入れる日の初日を入力。
2010/8/1　のような形式です。

Sheet３にシフト表が出来ます。
左から順に回数の多い順の並びです。

日付を横に見ると、それぞれの日に２人いるはずです。これが当番です。

ただ、回数の少ないほうの人は比較的前半に当番が集中してしまいがち、また、回数の多い人は終わりのほうに結構頻繁に順番が回ってきます。
あとは手作業での修正をしてみてはいかがですか。

コードは分量の都合上、次の回答に書きます。

お礼

最終です。
もし、できるなら、回数の少ない人は、間隔日数を多く、回数の多い人は間隔日数を少なくできないでしょうか？表を見てきづいたのですが・・・ここまでできるのであればできそうに思います。
当然、私には無理ですが・・・一番多い人で２３回（２名）少ない人で４回（７名）です。一人のひとの当たる間隔がだいたい同じ間隔で当たるように・・どうか、考えてください。
お願いします。そうできたら、完璧！！！です。
次々とすみません。

補足

すみません。違うページに説明していただいていたのですね。
ためしてみます。もし、できな立った時はまた、お願いいたします。
わたしに、できるといいのですが・・・とても期待しています。

回答No.3

hananoppo

ANo.1です。
手作業で、負担日数の多い順に一人ずつ、おおよそ等間隔になるように割り振るよりないと思いますが。
これ以上のことは私には分かりません。

お礼

ありがとうございました。解決できました。

回答No.2

noname#194317

ところで今回の相談は、単純な関数だけでは無理で、マクロの出番になりそうな規模の話では？関数の魔術師みたいな人だったら、マクロを使わずに何とかしちゃうかも知れませんが。

負担日数を均等割にするだけなら、全体日数／負担日数で求まります。端数は最終日で処理でしょうか。ただし単純に均等割にしただけだと、必ずどこかで重複したり、逆に誰もいない日ができると思われるため、そこは手動で調整するしかありません。もし期間中に1回とか2回しか当たらない家があるなら、そうした日の調整に入ってもらうのが楽そうです。そこは世話役さんの腕の見せ所かも。

もしかして、次のリンク先が役に立ちませんか？Excelを使って勤務表を作成する方法の解説と、フリーの勤務表作成支援ツールを紹介・配布しています。30名まで対応しているため、ちょうど今回の話に応用できそうだと思いました。

http://members.at.infoseek.co.jp/kenchan_h/index22.html

お礼

ありがとうございます。そうですか・・・魔術師ですか・・
参考のページをゆっくりとみてみたいとおもいます。
ありがとうございました。

回答No.1

hananoppo

等間隔の日数という考えでは、うまくいくとは思えません。
まず、期間が3～4か月間とありますが、おおよその全体日数を求めてください。
その後、各人の負担日数を計算します。
例えば、Ａさんの負担日数は次のようになります。
　　＝全体日数×2×Ａさんの田んぼ面積÷田んぼ面積合計
端数は四捨五入します。
四捨五入の関係で、負担日数の合計が全体日数×2にはほとんどならないと思います。その場合は、全体日数を入力し直して調整します。小数点以下にも入力すれば微調整ができます。
後は、各人の負担日数を満たすようにスケジュールを割り振ります。

お礼

ありがとうございました。どうにか解決できました。

補足

全体日数を決めて回答のようにしました。負担日数もでましたが、さて、そこからがわからないのです。全体日数は、１８０日（９０＊２）なのですが、どのように割り振ればよいのでしょうか？個人の割り振られる日が近すぎたり、日数が空きすぎたりせずに、当たるようにするには？
また、二人がペアなので、二つのグループに分けた場合、同じ人が同じ日に当たったり、翌日にまた当たったりせずに、個人個人のおおよその間隔日数を維持しながら割り当てることはできるでしょうか？簡単な関数など使えるのでしょうか？入力規則は？オートフィルで同じ人が近い日に入力できなくすることは？説明が下手なので、わかりにくいとはおもいますが、是非、是非回答よろしくお願いします。