[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『数字の組み合わせ』（白山）
１から１５までの数字の中から好きな数を２個選び、残りの数字から更に２個選びセルに書き出します。 初めに選んだ数字は足し算、後から選んだ数字は引き算をします。 足し算の答えと引き算の答えが同じ数を全て書き出したいのですがよろしくお願いします。 初 後 2 5 7 15 8 7
Excel2003,WindowsXP
今回の件だけであれば、人力で組合せを選んでいっても 大した労力ではなさそうに思いますが。。。？
一つ目を「1」から考えて行くと [A] [B] [C] [D] [E]★ [F] [G]★ [H] [I]★ [J] [K]★ [L] [M]★ [N] [O]★ [P] [Q]★ [R] [S]★ [T] [U]★ [V] [W]★ [X] [Y]★ [Z] [AA]★ [AB] [AC]★ [AD] [AE]★ [AF] [AG]★ [AH] [1] 1 2 3 1 4 2 5 3 6 4 7 5 8 6 9 7 10 8 11 9 12 10 13 11 14 12 15 13 14 15 [2] 1 3 4 1 5 2 6 3 7 4 8 5 9 6 10 7 11 8 12 9 13 10 14 11 15 [3] 1 4 5 1 6 2 7 3 8 4 9 5 10 6 11 7 12 8 13 9 14 10 15 [4] 1 5 6 1 7 2 8 3 9 4 10 5 11 6 12 7 13 8 14 9 15 [5] 1 6 7 1 8 2 9 3 10 4 11 5 12 6 13 7 14 8 15 [6] 1 7 8 1 9 2 10 3 11 4 12 5 13 6 14 7 15 [7] 1 8 9 1 10 2 11 3 12 4 13 5 14 6 15 [8] 1 9 10 1 11 2 12 3 13 4 14 5 15 [9] 1 10 11 1 12 2 13 3 14 4 15 [10] 1 11 12 1 13 2 14 3 15 [11] 1 12 13 1 14 2 15 [12] 1 13 14 1 15 [13] 1 14 15 [14] 1 15 16 ↑ ↑ ↑和 ｜ ｜二つ目の値 ｜一つ目を「1」に決めた場合 もうひとつの値をB列に並べ、C列に和を求めます。 E,G,I・・・の★の列に一旦すべての値を羅列して F,H,J・・・に、差がC列と一致する様にデータを配置します。
E列の「1」は、A列で使っていてこの組合せは出来ないので、E,F列はデータを削除。 また、各行によってB列の値と等しい値を含む組合せも出来ないのでそれらも削除。
すると、こんな感じで残ります。 [A] [B] [C] [D] [E]★ [F] [G]★ [H] [I]★ [J] [K]★ [L] [M]★ [N] [O]★ [P] [Q]★ [R] [S]★ [T] [U]★ [V] [W]★ [X] [Y]★ [Z] [AA]★ [AB] [1] 1 2 3 3 6 4 7 5 8 6 9 7 10 8 11 9 12 10 13 11 14 12 15 [2] 1 3 4 2 6 4 8 5 9 6 10 7 11 8 12 9 13 10 14 11 15 [3] 1 4 5 2 7 3 8 5 10 6 11 7 12 8 13 9 14 10 15 [4] 1 5 6 2 8 3 9 4 10 6 12 7 13 8 14 9 15 [5] 1 6 7 2 9 3 10 4 11 5 12 7 14 8 15 [6] 1 7 8 2 10 3 11 4 12 5 13 6 14 [7] 1 8 9 2 11 3 12 4 13 5 14 6 15 [8] 1 9 10 2 12 3 13 4 14 5 15 [9] 1 10 11 2 13 3 14 4 15 [10] 1 11 12 2 14 3 15 [11] 1 12 13 2 15 [12] [13] [14] 以下、A列を2の場合・・・と順にやって行って 組合せを作成されてはどうでしょう。
(HANA)
今回のためだけの使い捨てマクロです。 答えさえでればいいよねと、全組み合わせを評価しています。 もっとスマートな方法があるかどうかは知りません。
Sub test()
Dim a As Long, b As Long, c As Long, d As Long
Dim i As Long
Application.ScreenUpdating = False
For a = 1 To 15
For b = 1 To 15
For c = 1 To 15
For d = 1 To 15
If a <> b Then
If a <> c Then
If a <> d Then
If b <> c Then
If b <> d Then
If c <> d Then
If a + b = c - d Then
i = i + 1
Cells(i, 1) = a
Cells(i, 2) = b
Cells(i, 3) = a + b
Cells(i, 5) = c
Cells(i, 6) = d
Cells(i, 7) = c - d
End If
End If
End If
End If
End If
End If
End If
Next
Next
Next
Next
Application.ScreenUpdating = True
End Sub
手作業ならこんな感じかな。簡単にできるがVBAとなるとムムム。 識者の解答を待ちましょう。 1＋2=3 15-12=3 1＋3=4 15-11=4 1＋4=5 15-10=5 1＋5=6 15-9=6 1＋6=7 15-8=7 1＋8=9 15-6=9 1＋9=10 15-5=10 1＋10=11 15-4=11 1＋11=12 15-3=12 1＋12=13 15-2=13 2＋1=3 15-12=3 2＋3=5 15-10=5 2＋4=6 15-9=6 2＋5=7 15-8=7 2＋6=8 15-7=8 2＋7=9 15-6=9 2＋8=10 15-5=10 2＋9=11 15-4=11 2＋10=12 15-3=12 2＋12=14 15-1=14 (<_>)
マナさんのコードは、15P4の順列リストを全部チェックする方法ですね！！
前半は、足し算なので交換法則が成り立ってしまうので、 リストが重複してしまいますねえ
例
1 2 3 6 3 3
2 1 3 6 3 3
これは、よいのかなあ？？
私がやるなら、 15C2と13C2でチェックするかなあ？
最初の二つの和が15以上だったら、調査しないようなロジックが 今は、思い浮かんでいますが・・・。
ichinose
>b>aにすればよいのかな ですね！！
私は、組合せや順列の処理は、メインプロシジャーとは、分けてしまうので以下のような コードは、まず書きませんが、
久しぶりにやってみました。
Sub test()
Const cnt = 15
Dim a As Long, b As Long, c As Long
Dim i As Long
Application.ScreenUpdating = False
For a = 1 To cnt
For b = a + 1 To cnt
If a + b <= cnt - 1 Then
For c = 1 To cnt
If c <> a And c <> b And c + a + b <= cnt Then
i = i + 1
Cells(i, 1) = a
Cells(i, 2) = b
Cells(i, 3) = a + b
Cells(i, 5) = c + a + b
Cells(i, 6) = c
Cells(i, 7) = a + b
End If
Next c
Else
Exit For
End If
Next b
Next a
Application.ScreenUpdating = True
End Sub
色々と気づかせてくれたものがありました。
ichinose
おはようございます。 みなさま、ご協力頂き大変ありがとう御座いました。 ichinose様・マナ様、コードを示して頂きとても省力でき助かりました。 （白山）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.