Results of 1 - 1 of about 37677 for IF (0.007 sec.)
- [[20061225182121]]
- #score: 1591
- @digest: e51b31af03ba1e74d0dbeae6fff0f983
- @id: 27541
- @mdate: 2007-01-02T07:05:53Z
- @size: 9426
- @type: text/plain
- #keywords: 村屋 (15497), 役萬 (15241), combin (12800), remove (11437), 屋( (10831), 試合 (10129), 合目 (7757), removeall (6245), 中村 (5386), 人以 (4444), data (4346), integer (3891), 小山 (3606), ルゴ (3268), ん= (3238), cnt (3160), 加者 (2987), rand (2977), 組合 (2962), 人数 (2832), リズ (2764), ズム (2719), ary (2689), tbl (2675), 目: (2469), dic (2413), 参加 (2123), empty (1824), ubound (1722), worksheetfunction (1430), cells (1429), ゴリ (1413)
- 『組み合わせ』（teni）
2人対2人の試合の組合せなんですが、参加人数によってランダムな組み合わせを求めるのはどうしたらいいんでしょうか? 5人の場合 1試合目:1と2 3と4 （5は休憩） 2試合目:2と3 4と5 ・ ・ ・ ・ ・ ・ みたいな。 ---- 例えばこんなのはどうですか? Aのセルに試合の番号と組み合わせを入れておきます。 Bのセルに参加者の名前を全て入れます。 Cのセルには関数として=RAND()を参加者の人数分入れます。 （これは、C1のセルに=RAND()と入力しそのままマウスをC1セルの右下の 合わせるとカーソルが十時になるのでそこでダブルクリックすればOKです） A B C 1 1A 小山さん =RAND() 2 1A 山田さん =RAND() 3 1B 中村さん =RAND() 4 1B 中村さん =RAND() 5 村上さん =RAND() 6 ここまで出来たらBとCのセルを2列とも選択し、メニューの 「データ」-＞「並び替え」で「最優先されるキー」をC列に してOKをクリックするとB列の順番がバラバラなるので、 Aのセルに試合番号が入っている人が試合がある人で、ない人は 休憩って感じですね。 それと、一度BとCのセルを選択した状態で、再度並び替えを 行なうと、違う組み合わせになるはずです。 人数が8人以上になったら、A列に「2A」とか「2B」を入れて やれば使えます。 自動でA列に値を入れるのは関数でも出来そうですけど、とりあえず 考え方としてはこんなもんでどうでしょうか? （こいん） ---- コメントありがとうございます。できれば下記のような簡単な感じにしたいのですが、やはりマクロに足をつっこんしまわないとだめですかね?人数を入力するとずらずらーーと組合せがでてくる 人数入力 5人 1 2 VS 3 4 2 3 VS 4 5 ・ ・ ・ ・ ・ ---- どのようなアルゴリズムで組み合わせを作るかが分かれば(解決すれば)それをエクセル に実行させることができると思いますが、皆さんそこで困っているのだと思います。 アルゴリズムが解決しないと、マクロでも難しいでしょう。 人数は何人ぐらいを想定していますか? あらかじめ人間が組み合わせを考えておくのはダメですか? (ちゅうねん) ---- 新春お遊び第1弾!（笑 前回麻雀の組合せで役萬をあがった純丸はんも、役萬振り込んだsinしゃんもおりたみ たいで一向に回答がつきまへんなぁ。（笑 これ、偶数奇数があって確たる規則性は発見でけまへんワ。 で、まぁ、今んとこ6人以下の限定バージョンですけど試してみてくらはい。 またヒマでけたら考えてみますけど、難しいかも・・・ 余分な作業が入ってますけど、これは6人以上を考えてのモンですから気ぃになさらず にネ。 どなたか遊んでみまへんか? （弥太郎） Dim dic As Object, Cnt As Integer, t As Integer, tbl Dim n As Integer, i As Long, p As Integer, q As Integer, x As Integer Sub 組合せ() Dim data As Integer Dim m As Integer, y As Integer, num As Long, ary Dim v As Integer, w As Integer, u As Integer, n As Integer Cells.Clear Set dic = CreateObject("scripting.dictionary") data = Val(StrConv(InputBox("総人数を入力してくらはい。"), vbNarrow)) If data = 0 Then Exit Sub Application.ScreenUpdating = False num = WorksheetFunction.Combin(data, 2) t = 1 Cnt = data x = 1 m = 1 If data < 4 Then MsgBox "それくらいわかりまっしゃろ!" Exit Sub ElseIf data > 6 Then MsgBox "このマクロは未だその機能をサポートしとりまへん" Exit Sub Else w = WorksheetFunction.Combin(data - 2, 2) End If ReDim ary(1 To data) For i = 1 To data ary(i) = i Next i For i = 1 To num If i = Cnt Then x = x + 1 y = y + 1 Cnt = data + x + y End If n = n + 1 n = IIf(i = Cnt, 1, n) t = IIf(i = Cnt, t + 1, t) Cells(m, 1).Resize(w) = t Cells(m, 2).Resize(w) = t + n m = m + w If n + t = data Then n = 0: t = t + 1 Next i For c = num * w To 1 Step -1 If Int(data / 2) < Cells(c, 1) Then Cells(c, 1).Resize(, data - Int(data Mod 2)).Delete shift:=xlUp End If Next c If data > 4 Then Call 中村屋(ary, data, w) Else tbl = Cells(1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row, 2).Value Cnt = 0 For i = 1 To UBound(tbl, 1) dic(tbl(i, 1)) = Empty dic(tbl(i, 2)) = Empty t = 1 For y = 1 To data - 2 - (data Mod 2) For p = t To UBound(ary) If Not dic.exists(ary(p)) Then Cells(i, y + 2) = ary(p) dic(ary(p)) = Empty t = p If y = 1 Then m = p Else v = p End If Exit For End If Next p Next y u = IIf(i Mod 3 = 1, m, IIf(i Mod 3 = 2, v, IIf(i Mod 3 = 0, 5, 0))) If Cnt = 0 Then n = v Cnt = Cnt + 1 If i Mod WorksheetFunction.Combin(data - 2, 2) = 0 Then dic.removeall ElseIf Cnt = 1 Then dic.Remove (u) Else dic.Remove (u) dic.Remove (n) End If If Cnt = 3 Then Cnt = 0 Next i For i = UBound(tbl, 1) To 1 Step -1 If Cells(i, 3) < Int(data / 2) Then Cells(i, 1).Resize(, 4).Delete shift:=xlUp End If Next i End If Application.ScreenUpdating = True Set dic = Nothing End Sub Sub 中村屋(ary, data, w) Dim n As Integer, f As Integer, mei As Integer, b As Integer Dim cnt_b As Integer If w >= 6 Then For y = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -6 Cells(y, 1).Offset(-2).Resize(3, 2).Delete shift:=xlUp Next y End If tbl = Cells(1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row, data - Int(data Mod 2)).Value Cnt = 0 If WorksheetFunction.Combin(data - 2, 2) >= 1 Then mei = Int(WorksheetFunction.Combin(data - 2, 2) / 2) + data Mod 2 cnt_b = IIf(data - (data Mod 2) > 4, data - (data Mod 2), 3) For f = 3 To cnt_b Step 2 b = b + 1 For i = 1 To UBound(tbl, 1) For n = 1 To UBound(tbl, 2) If Not IsEmpty(tbl(i, n)) Then dic(tbl(i, n)) = Empty End If Next n t = 1 For y = 0 To 1 For p = t To UBound(ary) If Not dic.exists(ary(p)) Then Cells(i, f + y) = ary(p) tbl(i, f + y) = ary(p) t = p + 1 Exit For End If Next p Next y If f + 1 <> cnt_b Then dic.removeall For q = 1 To UBound(tbl, 2) If Not IsEmpty(tbl(i, q)) Then dic(tbl(i, q)) = Empty End If Next q On Error Resume Next Cnt = Cnt + 1 If Cnt Mod mei = 1 Then If b = 1 Then dic.Remove tbl(i, f) Else dic.Remove tbl(i, f + 1) End If ElseIf f = cnt_b Then dic.Remove tbl(i, f + 1) dic.Remove tbl(i - 1, f + 1) ElseIf Cnt Mod mei = 2 Then If b = 1 Then If UBound(ary) < 6 Then dic.Remove tbl(i, f + 1) dic.Remove tbl(i - 1, f + 1) Else dic.Remove tbl(i, f) dic(tbl(i - 1, f + 1)) = Empty End If Else dic.Remove tbl(i, f) dic.Remove tbl(i - 1, f) End If Else dic.removeall End If If i Mod 3 = 0 Then Cnt = 0: Cnt_c = 0: dic.removeall End If End If If f + 1 = cnt_b Then dic.removeall Next i If f + 1 < cnt_b Then For x = UBound(tbl, 1) To 1 Step -1 If Cells(x, f) = 1 Then Cells(x, 1).Resize(, f + 1).Delete shift:=xlUp End If Next x End If tbl = Cells(1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row, _ Cells(1, 1).End(xlToRight).Column) Next f End If For i = UBound(tbl, 1) To 1 Step -1 If Cells(i, 3) = "" Or Cells(i, 3) = 1 Then Cells(i, 1).Resize(, data - (data Mod 2)).Delete shift:=xlUp End If Next i End Sub... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/200612/20061225182121.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97032 documents and 608183 words.
訪問者：