AからJまでの10人を1組2人づつに分ける組み合わせは
COMBIN(10,2)+COMBIN(8,2)+COMBIN(6,2)+COMBIN(4,2)=94通り
と思われますが、これら94の組み合わせの中から、任意の1つをランダムに表示出来るようにしたい、できればEXCEL(関数またはマクロ)で。
よろしくお願いいたします。

このQ&Aに関連する最新のQ&A

A 回答 (4件)

>ランダムな順に10人をピックアップ」も人手ではなくパソコンでやって


>ほしいのです。

他の方の回答も含めて、そのつもりで回答されていると思いますけれど、何を人手でやるおつもりなのでしょうか?
マクロでやるならその通りの処理をOpenイベントで実行すればできますし、関数利用でも別に難しいことではありません。

関数の場合の一例を、説明した手順通りに分解して表示するなら…
A1~J1に対象となる名前があるとして
A2に =RAND()               :順番のもとになる乱数
A3に =RANK(A2,$A2:$J2)        :乱数を元に順番付け
A4に =MATCH(COLUMN(),$A3:$J3,0) :順に並べた時の対称の列番号
A5に =INDEX($A1:$J1,A4)        :乱数の順に並べ替えた名前
を入力して、A2~A5を選択して、右にコピーフィル。
5行目に乱数順に並べ替えた名前が表示されます。
(組み合わせは先頭から2人ずつ)

計算の手順がわかるように、1行ずつに途中経過を表示していますが、実際は途中を省略できますので、あとは適当にアレンジしてください。

(注意)Rankを使用しているので、乱数値がたまたままったく同じ値だとうまくいきませんが、RANDは実数になるので、そのようなことが起こる確率は非常に少ないと考えてよいとしています。
    • good
    • 0
この回答へのお礼

本題の内容について私の説明が不十分だったため、回答者の方々に真意を伝え切れず、申し訳けありませんでした。

今回のfujillinさんの回答は、私の質問に完全にこたえるものであることを実際にその通りにトライした結果、確認出来ました。

本当に有難うございました。

お礼日時:2009/05/15 19:05

1つの組み合わせだけを選択すれば良いのであれば、全部の組み合わせを前もってリストアップしておく必要はないのではないかな?



例えば、ランダムな順に10人をピックアップして、選んだ順に最初の2人を一組目、次の2人第二組…としてあげれば、結果的に全体の中からランダムに組み合わせを1つ選択したのと同じになるはずでは?
    • good
    • 1
この回答へのお礼

>全部の組み合わせを前もってリストアップしておく必要はないのではないか<
そうです、「全部の組み合わせを前もってリストアップする必要はなく、そのなかの任意の1つの組み合わせ(2人X5組)を人手を介せずに表示いたいのです。

>ランダムな順に10人をピックアップして、選んだ順に最初の2人を一組目、次の2人第二組…<
「ランダムな順に10人をピックアップ」も人手ではなくパソコンでやってほしいのです。

あるところまで人手と介する方法は、実践的には有効かもしれませんが。ここでは、RUNするだけで自動的にランダムにピックアップされた10人(5組)を表示してほしいわけです。

お礼日時:2009/05/13 22:44

直感的に45通りかな?



十分表に収まるので簡単ですね。
    • good
    • 0
この回答へのお礼

質問の内容について私の説明が不十分だったため、Tasuke22さんには真意を伝え切れず、申し訳けありませんでした。

表に収めると多分45通りと思いますので、後ほど確認したいと思います。ただ、45通り全部を表に出すのが目的ではなく、F9を押す度にその45通りのどれか1つが表記されればいいのです。

有難うございました。

お礼日時:2009/05/15 19:26

すべての場合を Excel に一列に書いて、ランダムに選べばいいのでは?



# そもそも 94組なのか?
    • good
    • 0
この回答へのお礼

私の説明が不十分だったため、koko_u_uさんには真意を伝え切れず、申し訳けありませんでした。

この問題は、最新回答で解決しましたが、後ほど「すべての場合を Excel に一列に書いて」見たいと思います。多分94通りではなさそうです。ただ、「全部を書き出す」のが目的ではなく、F9を押す度にその中の「どれか1つがランダムに表記」されればいいのです。

有難うございました。

お礼日時:2009/05/15 19:34

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QExcelでの全通りの組み合わせ出力方法(文字列)

Excelについて全くの初心者で、教えて頂きたい質問があります。

Excelの文字列の全通りの組み合わせを出力がしたいのですが、その方法が分かりません。
例えばセルAに
・りんご
・みかん
・いちご

セルBに
・だいこん
・キャベツ
・トマト

があり、別のセルにその全通りの組み合わせを出力
(文字と文字の間はスペース)

りんご だいこん
りんご キャベツ
りんご トマト
みかん だいこん
みかん キャベツ
みかん トマト
いちご だいこん
いちご キャベツ
いちご トマト

この様に出来る方法はあるでしょうか?
また出来ればその裏(だいこん りんご)も出力したいと考えており、キーワードは3つまで出来るようになりたいです。

どなたかご存じでしたら、ぜひお教え下さい。
よろしくお願いします。

Aベストアンサー

A列B列は1行目からデータがあるものとします。
C列に転記するものとします。

以下の手順をおためしください。

1.Altキー+F11キーでVisualBasicEditorを呼び出します。

2.メニューから挿入、標準モジュールで出てきたコードウィンド(右側の白い広い部分)に以下のコードをコピペします。

Sub test01()
a = Cells(Rows.Count, "A").End(xlUp).Row 'A列最終行取得
b = Cells(Rows.Count, "B").End(xlUp).Row 'B列最終行取得
For i = 1 To a '1行からA列最終行まで繰り返し
For n = 1 To b '1行からB列最終行まで繰り返し
x = x + 1
Cells(x, "C") = Cells(i, "A") & " " & Cells(n, "B") 'C列に結合して転記
Next n
Next i
End Sub

3.Alt+F11キーでワークシートへもどります.

4.メニューから、ツール、マクロ、マクロで出てきたマクロ名(test01)を選択して実行

これでできます。
これがわかれば「裏」というのも簡単ですよね。
以上はVBAでの回答ですが、外していたらごめんなさい。

A列B列は1行目からデータがあるものとします。
C列に転記するものとします。

以下の手順をおためしください。

1.Altキー+F11キーでVisualBasicEditorを呼び出します。

2.メニューから挿入、標準モジュールで出てきたコードウィンド(右側の白い広い部分)に以下のコードをコピペします。

Sub test01()
a = Cells(Rows.Count, "A").End(xlUp).Row 'A列最終行取得
b = Cells(Rows.Count, "B").End(xlUp).Row 'B列最終行取得
For i = 1 To a '1行からA列最終行まで繰り返し
For n = 1 To b '1行...続きを読む

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

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

Aベストアンサー

#4です。以下貼り付けください。
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

#4です。以下貼り付けください。
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, _
Order...続きを読む

Q【大至急お願いします!!】エクセルを使ってシフト表を作成したい

【大至急です!!】
エクセルを使ったローテーションの作成方法を教えてください!!
エクセル初心者です。

人事異動で以下のような窓口当番のローテーションを作成することになりました。

会社のパソコンのセキュリティ上フリーソフトは使用できず、また、私自身のパソコンスキルからエクセルを使用して作成するよりほかないと考えています。
(私自身はマクロは使えません。)

エクセルのバージョンは2010です。

どのような方法があるか詳しくお教え下さい。

1.10名程度で2つの窓口を担当する。

2.1つの窓口に1名の担当者がつきます。

3.担当者は午前と午後で交代する。(=2名×2名で1日つき4名が必要)

4.休暇や繁忙時期を考慮する必要があるため、適宜担当できない日を考慮する必要がある。(繁忙期や休暇というのは、人によって取得日が違うため個別対応が必要という意味です。)

5.担当者の経験が分かれるため、10名を2グループに分け、なおかつ顔合わせもランダムになるようにしたいです。



ざっくりしているかもしれませんが、以上です。宜しくお願いします。

【大至急です!!】
エクセルを使ったローテーションの作成方法を教えてください!!
エクセル初心者です。

人事異動で以下のような窓口当番のローテーションを作成することになりました。

会社のパソコンのセキュリティ上フリーソフトは使用できず、また、私自身のパソコンスキルからエクセルを使用して作成するよりほかないと考えています。
(私自身はマクロは使えません。)

エクセルのバージョンは2010です。

どのような方法があるか詳しくお教え下さい。

1.10名程度で2つの...続きを読む

Aベストアンサー

>窓口が午前・午後各2名ある場合は各列にコピペして増やせば良いのでしょうか
いや、全員を2つのグループに分けてそれぞれのグループから1人ずつという風に理解していたので、その表は一人しか選びません。だって、経験によって2つのグループに分けるのですから、多分ベテランと新人のグループに分けるんでしょう?ですから、ベテラン用の表と新人用の表を2つつくってそれぞれから1人ずつ選ぶという使い方を想定しています。
もし一つの表で2人選ぶということであれば(もちろんそれが要求仕様なのですが)、根本的に作り替えなければならないので、申し訳ないですがお手伝いできないです。
ただ、別の方がアイデアをお持ちかもしれませんので、その「担当者の経験が分かれるため、10名を2グループに分け」が具体的にどういう意味なのか捕捉されておくとよいでしょう。不躾ながら正直言うとベテラン用と新人用で分けてそれぞれから一人ずつ選べばいいんじゃないかなぁ、としか思えないのです。

>お教えいただいた形の場合、何か入力するたびに再計算されるのですが、そもそもそうゆうものなのでしょうか?
そうです。ですから、エクセルの設定を手動計算にする必要があります。
リボンに「計算」というタブがあります。そこに「計算方法の設定」という項目がありますから、そこで設定します。詳しくはこちらをどうぞ↓。
https://121ware.com/qasearch/1007/app/servlet/relatedqa?QID=012854
再計算するにはF9を押します。

>午後当番→同じ方が午前当番となってしまう事例が発生しています
それはそうなると知っていました。午前と午後で交代するということだけだったので、日付が変われば午後と午前でつながってもいいという意味だと思っていました。でも午後-午前も一緒に禁止する方が実装するのは簡単です。Plan Optimized の部分は第一日目の午前を除いて、全部同じにすればいいです。つまり第一日目の午後をそのままま全シフトにコピーすれば午後-午前もなくなります。
ただ前の月の最後のシフトとの関係は人間が確認しなければならないです(これは前のバージョンでも同じ)。

>何度再計算しても各人の当番回数がかなりばらついてしまいます。
そうですね。それは手で調整することを想定しています。私の手元では5人の表を作ったので何回かやるといい感じのが出てくるのですが、それでも特定の期間にかたまってしまうというようシフト表になってしまいます。10人でやるとさらに理想的なシフト表ができにくいかもしれません。でもまるっきり白紙の状態から手で作るよりはかなり楽になるのと思うのですが。
また、本質的な解決方法じゃないですが、過去の3シフトに入っていた人からは選ばない、というような条件を付け加えると、少しはましになるようです。「過去の3シフト」の縛りを加えるには、Plan Optimized の項目で第2日目の午後シフトを =If(CountIf(B24:D24,"√")>0,"x",If(E4="x","x","")) として下と右にコピーしていきます。ただし、この縛りを入れると、とても規則的なシフト表になるとか、誰も入れない日がいくつも出てくるとか、別の問題も出てきます。

>パソコンに詳しい方からすれば無茶な質問であることは理解しております。
私はそうは思いませんが、ただエクセルのファイルのままで渡せないとかいうのがありますので、こういう掲示板でやり取りするとちょっと時間かかるのはたしかですね。

>窓口が午前・午後各2名ある場合は各列にコピペして増やせば良いのでしょうか
いや、全員を2つのグループに分けてそれぞれのグループから1人ずつという風に理解していたので、その表は一人しか選びません。だって、経験によって2つのグループに分けるのですから、多分ベテランと新人のグループに分けるんでしょう?ですから、ベテラン用の表と新人用の表を2つつくってそれぞれから1人ずつ選ぶという使い方を想定しています。
もし一つの表で2人選ぶということであれば(もちろんそれが要求仕様なのですが)、根本...続きを読む

Qエクセルでランダム組み合わせする方法

はじめまして、エクセルを使用してある集団からランダムに組み合わせを作りたいのですがよい方法あるいはヒントがあればアドバイスをいただきたいのでよろしお願いします。
具体的には、7列12行の席があり、その中からランダムに7席(名)を選んで1~3チームを作るというものです。各チーム内で重複しないようにし、7席(名)を選択する方法あればベストですが、それに近い方法でもよいです。(結果を見て、重複席を自分で変更するなど微調整できればよいと思っています。
ちなみに7列12行のそれぞれのセルには氏名か番号をつける予定です。
よろしくお願いします。

Aベストアンサー

[回答番号:No.4この回答への補足]に対するコメント、

   A  B  C  …  G
1      座席表
2  A01 B01 C01 … G01
3  A02 B02 C02 … G02
4  A03 B03 C03 … G03
… …  …  …  … …
13 A12 B12 C12 … G12

    Q   R
1  乱数  名前
2  0.9199 A01
3  0.0623 B01
4  0.1686 C01
… ……… …
8  0.2037 G01
9  0.3649 A02
10 0.8395 B02
… ……… …
84 0.3442 F12
85 0.6138 G12

Q2: =RAND()
R2: =OFFSET($A$2,INT((ROW(A1)-1)/7),MOD(ROW(A1)-1,7))

    I    J  K  L  M  N  O
1  チーム名     メンバー名前
2  Team_01  D11 E07 C03 B07 G02 F10
3  Team_02  B05 B01 C09 A04 B10 A09
4  Team_03  E02 B06 B08 E11 C07 C01
… ………  …  …  …  …  …  …
13 Team_12  E03 A01 F08 E09 E06 F05

J2: =VLOOKUP(SMALL($Q$2:$Q$85,COLUMN(A1)+(ROW(A1)-1)*7),$Q$2:$R$85,2,0)

[回答番号:No.4この回答への補足]に対するコメント、

   A  B  C  …  G
1      座席表
2  A01 B01 C01 … G01
3  A02 B02 C02 … G02
4  A03 B03 C03 … G03
… …  …  …  … …
13 A12 B12 C12 … G12

    Q   R
1  乱数  名前
2  0.9199 A01
3  0.0623 B01
4  0.1686 C01
… ……… …
8  0.2037 G01
9  0.3649 A02
10 0.8395 B02
… ……… …
84 0.3442 F12
85 0.6138 G12

Q2: =RAND()
R2: =OFFSET($A$2,INT((ROW(A1)-1)/7),MO...続きを読む

Qエクセルで公平にチーム分けする方法を教えて下さい

20人のメンバーを2チームに分け毎週スポーツの練習をしています。毎回公平にチームメンバーが入れ替わる様にエクセルで設定してチーム分けのメンバー表を作りたいのですが、ご存じの方教えてください。

Aベストアンサー

他の方もご指摘されていますように、「公平」の意味がよく分かりませんが
「同じ組み合わせが無いように」という理解で考えてみました。
乱数を使用する方法では、低確率ですが同じ組み合わせが発生し得ます。

※以下Excel2007以降のバージョンでやって下さい。

メンバー20名の名前を横にA1セル~T1セルへ入力します。
[F11]キーを押して、左上のプロジェクトエクスプローラーからSheet1(Sheet1)を
Wクリックします。
右側のエディタエリアに以下のコードを貼り付けます。

Sub sample()
rIdx = 1
For i1 = 1 To 20
For i2 = i1 + 1 To 20
For i3 = i2 + 1 To 20
For i4 = i3 + 1 To 20
For i5 = i4 + 1 To 20
For i6 = i5 + 1 To 20
For i7 = i6 + 1 To 20
For i8 = i7 + 1 To 20
For i9 = i8 + 1 To 20
For i10 = i9 + 1 To 20
rIdx = rIdx + 1
Cells(rIdx, i1).Value = "A"
Cells(rIdx, i2).Value = "A"
Cells(rIdx, i3).Value = "A"
Cells(rIdx, i4).Value = "A"
Cells(rIdx, i5).Value = "A"
Cells(rIdx, i6).Value = "A"
Cells(rIdx, i7).Value = "A"
Cells(rIdx, i8).Value = "A"
Cells(rIdx, i9).Value = "A"
Cells(rIdx, i10).Value = "A"
For i = 1 To 20
If Cells(rIdx, i).Value <> "A" Then Cells(rIdx, i).Value = "B"
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
MsgBox ("終了しました")
End Sub

[F5]を押して実行します。
お使いのPCの能力にもよりますが、終わるまでに数分かかります。

この結果が『20名をA・Bチームに分ける全ての組み合わせ』です。
これを上から順にやれば重複無くチーム分けを行えます。

ただ、実際問題として、全ての組み合わせは18万4756通りあり、全ての
組み合わせを試すには1日1通りならば500年以上かかることになりますが。

他の方もご指摘されていますように、「公平」の意味がよく分かりませんが
「同じ組み合わせが無いように」という理解で考えてみました。
乱数を使用する方法では、低確率ですが同じ組み合わせが発生し得ます。

※以下Excel2007以降のバージョンでやって下さい。

メンバー20名の名前を横にA1セル~T1セルへ入力します。
[F11]キーを押して、左上のプロジェクトエクスプローラーからSheet1(Sheet1)を
Wクリックします。
右側のエディタエリアに以下のコードを貼り付けます。

Sub sample()
rIdx = 1
For i1 = 1...続きを読む

Q重複しないグループ分けについて

https://oshiete.goo.ne.jp/qa/8843774.html

で質問してプログラムを組んでくれた方がいましたが
応用できない場面が出てきてしまったので再び質問させて
いただきます。

前回の質問ではすべて3グループに分けられるように
していただきましたが、実はグループ数を固定するのではなく
1グループの人数を3人に固定しなければならなかったのです。

前回回答していただいたVBAのプログラムを編集して
1~12までを3ずつ4グループになるべく重複をしないで
複数回、分けるにはどうしたらいいでしょうか?
できれば複数回分けたところで全部の数が最低1回は同じ
グループに入るようにできると助かります。

今回も1-2-12と1-2-11は重複と考えます。

まったく重複なしで行うのは不可能だということは
わかりますが、できるだけ少ない重複で複数回(今回は最低6回)のグループ分け
を行いたいと思います。

前回のプログラムに説明も付け加えていただきましたが
よく理解できずに今日まできてしまいました。
大変申し訳ありませんがどうかご教授お願いします。

https://oshiete.goo.ne.jp/qa/8843774.html

で質問してプログラムを組んでくれた方がいましたが
応用できない場面が出てきてしまったので再び質問させて
いただきます。

前回の質問ではすべて3グループに分けられるように
していただきましたが、実はグループ数を固定するのではなく
1グループの人数を3人に固定しなければならなかったのです。

前回回答していただいたVBAのプログラムを編集して
1~12までを3ずつ4グループになるべく重複をしないで
複数回、分けるにはどうしたらいい...続きを読む

Aベストアンサー

【つづき】

上記で出来上がった表を元に、組合せパターン数の表を作成するもの
#7後半にもありましたが、その表の右側に 1_2_3 の様な表示を追加しています。
#7後半のものでも構いません。

Public Sub CheckPtn()
  Dim dicPtn As Object
  Dim vA As Variant, vB As Variant, v As Variant
  Dim i As Long, j As Long, k1 As Long, k2 As Long
  Dim iGrp As Long
  Dim vS As Variant, sS As String

  Set dicPtn = CreateObject("Scripting.Dictionary")
  With Range("B2")
    vA = .CurrentRegion.Value
    iGrp = .Cells(1).MergeArea.Count
    ReDim vB(1 To UBound(vA, 2) + 1, 1 To UBound(vA, 2) + 1)
    vB(1, 1) = "組"
    For i = 2 To UBound(vB)
      vB(1, i) = i - 1
      vB(i, 1) = i - 1
      vB(i, i) = "A"
    Next
    For i = 2 To UBound(vA)
      If (Val(vA(i, 1)) > 0) Then
        For j = 1 To UBound(vA, 2) Step iGrp
          sS = ""
          For k1 = 0 To iGrp - 2
            sS = sS & "_" & vA(i, j + k1)
            For k2 = k1 + 1 To iGrp - 1
              vB(vA(i, j + k1) + 1, vA(i, j + k2) + 1) = _
                vB(vA(i, j + k1) + 1, vA(i, j + k2) + 1) + 1
              vB(vA(i, j + k2) + 1, vA(i, j + k1) + 1) = _
                vB(vA(i, j + k2) + 1, vA(i, j + k1) + 1) + 1
            Next
          Next
          sS = sS & "_" & vA(i, j + k1)
          sS = Mid(sS, 2)
          dicPtn(sS) = dicPtn(sS) + 1
        Next
      End If
    Next
    With .Offset(UBound(vA) + 2)
      .CurrentRegion.Clear
      With .Resize(UBound(vB), UBound(vB))
        .Value = vB
        On Error Resume Next
        .Cells.SpecialCells(xlCellTypeBlanks) _
          .Interior.ColorIndex = 38
        .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1) _
          .SpecialCells(xlCellTypeConstants _
                  , xlTextValues).ClearContents
        .Columns(1).Interior.ColorIndex = 36
        .Rows(1).Interior.ColorIndex = 36
        .Borders.LineStyle = xlContinuous
        .HorizontalAlignment = xlCenter
        .EntireColumn.AutoFit
      End With
      
      ReDim vS(1 To dicPtn.Count, 1 To 2)
      i = 1
      For Each v In mySort2(dicPtn.Keys)
        vS(i, 1) = Join(v(1), "_")
        vS(i, 2) = dicPtn(v(0))
        i = i + 1
      Next
      With .Offset(, UBound(vB) + 1)
        .CurrentRegion.Clear
        With .Resize(dicPtn.Count, 2)
          .Value = vS
          .Borders.LineStyle = xlContinuous
        End With
      End With
    End With
  End With
  Set dicPtn = Nothing
End Sub

Private Function mySort2(ByVal vA As Variant) As Variant
  Dim vR As Variant, vS As Variant, v As Variant
  Dim i As Variant, j As Variant, k As Long, n As Long

  ReDim vR(LBound(vA) To UBound(vA))
  For i = LBound(vA) To UBound(vA)
    vS = Split(vA(i), "_")
    For j = 0 To UBound(vS) - 1
      For k = j + 1 To UBound(vS)
        If (Int(vS(j)) > Int(vS(k))) Then
          v = vS(j)
          vS(j) = vS(k)
          vS(k) = v
        End If
      Next
    Next
    vR(i) = Array(vA(i), vS)
  Next
  For i = LBound(vR) To UBound(vR) - 1
    For j = i + 1 To UBound(vR)
      For k = 0 To UBound(vS)
        If (Int(vR(i)(1)(k)) < Int(vR(j)(1)(k))) Then
          n = 0
          Exit For
        ElseIf (Int(vR(i)(1)(k)) > Int(vR(j)(1)(k))) Then
          n = 1
          Exit For
        End If
      Next
      If (n > 0) Then
        v = vR(i)
        vR(i) = vR(j)
        vR(j) = v
      End If
    Next
  Next
  mySort2 = vR
End Function

※ mySort2 は、文字列で与えられたものを1度バラして・・・ってやってます
(元々数値の表側を見ればもっと少ない記述になりますが)

【つづき】

上記で出来上がった表を元に、組合せパターン数の表を作成するもの
#7後半にもありましたが、その表の右側に 1_2_3 の様な表示を追加しています。
#7後半のものでも構いません。

Public Sub CheckPtn()
  Dim dicPtn As Object
  Dim vA As Variant, vB As Variant, v As Variant
  Dim i As Long, j As Long, k1 As Long, k2 As Long
  Dim iGrp As Long
  Dim vS As Variant, sS As String

  Set dicPtn = CreateObject("Scripting.Dictionary")
  With Range("B...続きを読む

QExcelでデータ全通り組み合わせ出力方法

Excelでデータ全通り組み合わせ出力方法について教えて頂けますと助かります。

セルA~Eに、数がまちまちのアイテム名が入っています。
(セルA~Eというのは例で、変則的に全てのアイテム数は増減します。)

全ての組合せをセルG~Kに各々書き出してくれる方法はあるでしょうか?
(イメージ添付あり)

できればセルに入力すれば自動的に組合せが追加されていくのが理想です。
Excel2010を使用しており、VBAは初心者です。


どなたかご存じでしたら、ぜひお教え下さい。
よろしくお願いします。

Aベストアンサー

#1、2、cjです。#1、2、補足欄へのレスです。

取り急ぎ、コードのみ修正しました。
#2を元に書き換えています。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rSrc As Range
  Application.EnableEvents = False
  Set rSrc = Range("B2").CurrentRegion
  Application.EnableEvents = True
  If Intersect(Target, rSrc) Is Nothing Then Exit Sub
  Application.EnableEvents = False
  Call PrintCombi(rSrc)
  Application.EnableEvents = True
End Sub

Sub PrintCombi(ByVal rSrc As Range)
  Dim tnFld As Long
  Dim nRc As Long
  Dim nConti As Long
  Dim nRow As Long
  Dim i As Long
  Dim j As Long

  tnFld = rSrc.Columns.Count
  nConti = 1
  With rSrc(1, rSrc.Columns.Count + 3)
    .CurrentRegion.Clear
    Cells(1).Resize(, tnFld).Copy .Cells(1)
    For i = tnFld To 1 Step -1
      nRc = Cells(Rows.Count, i).End(xlUp).Row
      nRow = 2
      For j = 2 To nRc
        Cells(j, i).Copy Destination:=.Cells(nRow, i).Resize(nConti)
        nRow = nRow + nConti
      Next j
      nConti = nConti * (nRc - 1)
    Next i
    With .Cells(2, 1).Resize(nConti)
      For i = 2 To tnFld
        Range(.Cells(1, i), .Cells(.Cells.Count + 1, i).End(xlUp)).Copy Destination:=.Columns(i)
      Next i
    End With
  End With
End Sub

#1、2、cjです。#1、2、補足欄へのレスです。

取り急ぎ、コードのみ修正しました。
#2を元に書き換えています。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rSrc As Range
  Application.EnableEvents = False
  Set rSrc = Range("B2").CurrentRegion
  Application.EnableEvents = True
  If Intersect(Target, rSrc) Is Nothing Then Exit Sub
  Application.EnableEvents = False
  Call PrintCombi(rSrc)
  Application.EnableEvents = True
...続きを読む

Q21名で二人づつのペアでの畑の水入れ当番を作りたいと思います。21名が

21名で二人づつのペアでの畑の水入れ当番を作りたいと思います。21名がそれぞれの所有面積に応じて当番の当たる間隔日数を出しています。期間は考えずにローテーションによって回る当番です。所有面積の多い人で最小間隔日数が(7.74)日一名です。続いて(7.87)一名(9.1)一名(11.5)一名(14.97)一名(19.34)一名(22.1)一名(24.43)一名(25.78)一名(30.94)三名(38.67)二名(46.4)七名です。このそれぞれの間隔日数をあまり崩さないように当番を組んでいきたいのですが、二名ペアだということだとか、とても複雑でできそうにありません。
手書きで作ったりもしてみたのですが、できればエクセルで関数、を使って(マクロ)作りたいと思っています。一度詳しい方に質問したのですが、間隔日数が変動してしまい(その時は期間をきめていたので・・・)この案がメンバーに受け入れてもらえず、再びお知恵をお借りしたく質問させていただいています。私のPCレベルは中級ですが、マクロに関してはほとんど知識がないので、解読文章(わかりやすく)つきで、回答いただきたいと思います。
こんなの簡単だ!!と思われる方は是非回答よろしくおねがいします。

氏名  面積      間隔日数    比較順位
Aさん  60      7.74        1
Bさん  59      7.87        2
Cさん  51      9.1         3
Dさん  42      11.05       4
E     31      14.97      5
F     24      19.34       6
G     21      22.1        7
H     19      24.43       8
I      18      25.78       9
J      15      30.94      10
K      15      30.94      10
L      15      30.94      10
M      12      38.67      11
N      12      38.67      11
O      10      46.4       12
P      10      46.4       12
Q      10      46.4       12
R      10      46.4       12
S      10      46.4       12
P      10      46.4       12
U      10      46.4       12
面積  合計464  

このような感じです。困っています。間隔日数をある程度保ちながらできるだけ公平に組み合わせたいのです。
よろしくおねがいします。

21名で二人づつのペアでの畑の水入れ当番を作りたいと思います。21名がそれぞれの所有面積に応じて当番の当たる間隔日数を出しています。期間は考えずにローテーションによって回る当番です。所有面積の多い人で最小間隔日数が(7.74)日一名です。続いて(7.87)一名(9.1)一名(11.5)一名(14.97)一名(19.34)一名(22.1)一名(24.43)一名(25.78)一名(30.94)三名(38.67)二名(46.4)七名です。このそれぞれの間隔日数をあまり崩さないよう...続きを読む

Aベストアンサー

>エクセルのシートに氏名を表記したいのです。

下記のようにA列とB列に必要な情報を入力してから、VBAを実行してください。
E,F,G列に結果が表示されます。

  A列  B列
1 期間  90
2 人数  21
3
4 氏名  回数
5 A   23
6 B   23
7 C   19
8 D   16
9 E   12
10 F   9
11 G   8
12 H   7
13 I   7
14 J   6
15 K   6
16 L   6
17 M   5
18 N   5
19 O   4
20 P   4
21 Q   4
22 R   4
23 S   4
24 T   4
25 U   4


Sub 当番割当()
Dim 期間 As Integer
Dim 人数 As Integer
Dim 氏名() As String
Dim 回数() As Integer

Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim m As Integer
Dim n As Integer
Dim n1 As Integer
Dim n2 As Integer
Dim p As Single
Dim q As Single
Dim 当番() As String
Dim 担当() As Single

期間 = Cells(1, 2)
人数 = Cells(2, 2)
ReDim 氏名(人数)
ReDim 回数(人数)
For i = 1 To 人数
氏名(i) = Cells(4 + i, 1)
回数(i) = Cells(4 + i, 2)
Next i

ReDim 当番(期間 * 2)
ReDim 担当(期間 * 2)

n = 0
For i = 1 To 人数
n1 = 0
n2 = 0
For j = 1 To 人数
If 回数(j) = 回数(i) Then
n1 = n1 + 1
If j <= i Then n2 = n2 + 1
End If
Next j

p = 期間 / 回数(i)
For j = 1 To 回数(i)
q = p * (n2 - 0.5) / n1 + p * (j - 1)
m = 1
For k = n To 1 Step -1
If 担当(k) <= q Then
m = k + 1
Exit For
End If
当番(k + 1) = 当番(k)
担当(k + 1) = 担当(k)
Next k
当番(m) = 氏名(i)
担当(m) = q
n = n + 1
Next j
Next i

Range("E:G").Clear
For n = 1 To 期間
Cells(n, 5) = n & "日"
Cells(n, 6) = 当番(n * 2 - 1)
Cells(n, 7) = 当番(n * 2)
Next n
End Sub


VBAをここで詳しく解説することはできないので、ご自分で調べてみてください。
簡単なコマンドだけですので、そんなに難しくないと思います。


難しいのは、なぜこの方法で当番の割り当てができるのかだと思いますので、簡単に説明しておきます。

期間は90日ですが、この時間軸上に各担当者ごとに当番日時を均等に振り分けます。
例えば、Aさんは23回なので、90/23=3.91=3日22時間を計算して、
Aさんの1回目:3日22時
Aさんの2回目:7日20時
Aさんの3回目:11日18時
Cさんは19回なので、90/19=4.73=4日17時間を計算して、
Cさんの1回目:4日17時
Cさんの2回目:9日10時
Cさんの3回目:14日3時
というように配分します。
(実際はもう少し細かい計算をしていますが簡単に言うとこういうことです)
21名全員について同じように配分します。
しかしこのままでは、当番がいない日があったり、3人以上が当番になる日が発生しますので、
あとは、早い順に2名づつ当番に割り当てているだけです。

この方法で割り当てると、当番の間隔日数はそんなにずれることはないと思います。

>エクセルのシートに氏名を表記したいのです。

下記のようにA列とB列に必要な情報を入力してから、VBAを実行してください。
E,F,G列に結果が表示されます。

  A列  B列
1 期間  90
2 人数  21
3
4 氏名  回数
5 A   23
6 B   23
7 C   19
8 D   16
9 E   12
10 F   9
11 G   8
12 H   7
13 I   7
14 J   6
15 K   6
16 L   6
17 M   5
18 N   5
19 O   4
20 P   4
21 Q   4
22 R   4
23 S   4
2...続きを読む

Qエクセルで作成したカレンダーに「当番の名前」を自動的に入力する方法をお

エクセルで作成したカレンダーに「当番の名前」を自動的に入力する方法をおしえてください。


毎月エクセルで朝礼当番表を作っています。
土、日、祝がお休みです。
たとえば、1日に最初の人の名前を入力すると休みの日はぬかして、
順番に当番が入力されるという関数があれば教えてください。

1行目に「日にち」
2行目に「曜日」
3行目に「当番者名」

と簡単な表です。

リストからコピペしたら間違えてしまいました。

オートフィルで入力しようかと思ったのですが、休みの日を抜かすのが面倒で。


よろしくお願いします。

Aベストアンサー

>6行目(B6セル)に =IF(B6=0,MOD($B2-2+DAY(B3)-SUM($B5:B5),$B1)+1,0)
式を分解してみるとわかりやすいです。
更に
7行目に作業列 =$B2-2+DAY(B3)
    日にちごとに 日にち事に連続した番号になります。
8行目に作業列 =MOD($B2-2+DAY(B3),$B1)
    その番号を 人数で割ったあまりがでます。
9行目に作業列 =SUM($B5:B5)
    休みの数の合計がでます。

と入れて右へコピィしてみてください。
式のセルを指定する $B2 とか$マークが付く場合と付かない場合がありますよね。
絶対参照と呼びますが、意味は右へコピィしてもセルの位置を変動させないということです。
例えば
9行目の=SUM($B5:B5)の式を右へコピィした場合
=SUM($B5:B5)
=SUM($B5:C5)
=SUM($B5:D5)
・・・
と合計する範囲が広くなっていくように設定してあります。

別件ですが
カレンダーの日付をコピィの作業をしなくても良いように関数をいれておくことも出来ます。
   A     B   C   D・・・
1 人数    5   年  2010
2 最初の人  1   月   1
3 日付    10/1 10/2
4 曜日    金曜  土曜・・・
とD1セルに 年 の数値 D2セルに 月 を数値で入れます。
日付のB2セルには =DATE($D1,$D2,COLUMN(A1)) と入れて右へコピィしておきます
ここも 年と月を決める D1とD2のセルを指定するときは右へコピィしても変動しないように
$マークをつけておきます。
COLUMN(A1)はA1セルの列の番号です。右へコピィした場合に
COLUMN(B1)
COLUMN(C1) と変動する様に $マークは付けません。
*COLUMN(A1)は COLUMN(A2)でもACOLUMN(3)でもかまいません。
曜日のB3セルには =B2 と入れます。書式=>セル で表示形式のタブ ユーザ定義 で aaa
と入れると その日の表示が曜日になります。
B3セルも右へコピィします。
毎月、月の部分を変更するだけで その月のカレンダーになります。
表示形式については
http://www.excel.studio-kazu.jp/lib/e3g/e3g.html
などを参考にしてください。

>6行目(B6セル)に =IF(B6=0,MOD($B2-2+DAY(B3)-SUM($B5:B5),$B1)+1,0)
式を分解してみるとわかりやすいです。
更に
7行目に作業列 =$B2-2+DAY(B3)
    日にちごとに 日にち事に連続した番号になります。
8行目に作業列 =MOD($B2-2+DAY(B3),$B1)
    その番号を 人数で割ったあまりがでます。
9行目に作業列 =SUM($B5:B5)
    休みの数の合計がでます。

と入れて右へコピィしてみてください。
式のセルを指定する $B2 とか$マークが付く場合と付かない場合がありますよね。
絶対参照と呼び...続きを読む

Qエクセル2007で総当り表を作りたいです。

エクセル2007で俗に言う総当り表を作りたいのですが、分からないことがあり作成が進みません。
あれこれ調べてみたのですが私自身関数が得意というわけでもなく…こちらで質問させていただきます。

画像のように

(1)2行目のデータを、関数・オートフィルを用いて2列目に並べなおす
(2)同一のデータ同士が当たらないように、斜めに線を(自動で)引く

という状態にしたいと考えています。
それぞれ、どのような設定・関数を用いればよいのでしょうか?

Aベストアンサー

こんばんは!
質問の操作に関しては関数云々というより、コツコツ手を動かして操作するしかないと思います。
(1)2行目データを範囲指定 → 右クリック → コピー
(2)A3セルを選択 → 右クリック → 形式を選択して貼り付け → 「行列を入れ替える」にチェックを入れOK
(3)Ctrlキーを押しながら斜線を入れたいセルを選択 → 右クリック → セルの書式設定 → 「罫線」タブで「右下がりの斜線」を選択しOK
(4)最後にA2セル~最終セルを選択 → 罫線の「格子」を選択しOK

こういった流れになると思います。

これを自動で!というコトであればVBAになってしまいますが、一例です。
表を作成したい元データはB2セルから列方向に並んでいるとします。

画面左下の操作したいSheet見出し上で右クリック → コードの表示 → VBE画面のカーソルが点滅しているところに
↓のコードをコピー&ペースト → Excel画面に戻りマクロを実行してみてください。
(Alt+F8キー → マクロ → マクロ実行です)

Sub Sample1() 'この行から
Dim j As Long, lastCol As Long
lastCol = Cells(2, Columns.Count).End(xlToLeft).Column
Range(Cells(2, "B"), Cells(2, lastCol)).Copy
Range("A3").PasteSpecial Paste:=xlPasteAll, Transpose:=True
For j = 2 To lastCol + 1
Cells(j, j - 1).Borders(xlDiagonalDown).LineStyle = xlContinuous
Next j
With Range("A2").CurrentRegion
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
End With
End Sub 'この行まで

※ おそらく一度だけの操作になると思いますので、
わざわざマクロでやるよりご自身で手を動かした方が良いと思います。m(_ _)m

こんばんは!
質問の操作に関しては関数云々というより、コツコツ手を動かして操作するしかないと思います。
(1)2行目データを範囲指定 → 右クリック → コピー
(2)A3セルを選択 → 右クリック → 形式を選択して貼り付け → 「行列を入れ替える」にチェックを入れOK
(3)Ctrlキーを押しながら斜線を入れたいセルを選択 → 右クリック → セルの書式設定 → 「罫線」タブで「右下がりの斜線」を選択しOK
(4)最後にA2セル~最終セルを選択 → 罫線の「格子」を選択しOK

こういった流れになると思...続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報