足し算の組み合わせを考える
- 1,2,3の組み合わせの足し算について質問します。これをVBAでプログラミングしたいです。
- 組み合わせの足し算の結果は2,3,4,5,6となります。
- 系列数と数字の可変にも対応したプログラムを作成したいです。
- ベストアンサー
足し算の組み合わせ
組み合わせの足し算について質問します。 1,2,3という数字があったとします。 たとえば、この1,2,3を2系列用意し、それぞれ足します。 考えやすくするため、2系列を次のようにあらわします。 A系列=1,2,3 B系列=1,2,3 また、A系列の1をA1、B系列の2をB2などのように表現します。 考えられる組み合わせの足し算は次のようになります。 A1+B1=2 A1+B2=3 A1+B3=4 A2+B1=3 A2+B2=4 A2+B3=5 A3+B1=4 A3+B2=5 A3+B3=6 そして、ここから重複を排除すると、残る足し算の結果は、 2,3,4,5,6となります。 これをVBAでプログラミングしたいのですが、どのように考えればよいでしょうか。 もちろん、実際は、1,2,3・・・xまで可変とし、系列数も可変とします。 ただし、すべての系列は同じです。 つまり、A系列=1,2,3、B系列=1,2,3,4ということはありません。 たとえば、A系列が1,2,3,4だったら、のこりの系列もすべて1,2,3,4です。
- dansin_Goo
- お礼率44% (193/432)
- Visual Basic
- 回答数10
- ありがとう数5
- みんなの回答 (10)
- 専門家の回答
質問者が選んだベストアンサー
Private aryOrg As Variant Private aryTmp As Variant Sub main() Const rp = 3 '系列数 aryOrg = Array(0, 1.1, 2.2, 3.3, 4.4, 5.5) Dim aryRes() As Variant Dim i As Long, j As Long, k As Long Dim myMatch As Boolean aryTmp = aryOrg '全ての組み合わせを再帰的に取得 For i = 1 To rp - 1 Call subR(aryTmp) Next '重複を排除し配列に格納 ReDim aryRes(0) For i = 0 To UBound(aryTmp) myMatch = False For k = 0 To UBound(aryRes) If IsEmpty(aryRes(k)) = False And aryRes(k) = aryTmp(i) Then myMatch = True End If Next If myMatch = False Then aryRes(j) = aryTmp(i) j = j + 1 ReDim Preserve aryRes(j) End If Next For i = 0 To UBound(aryRes) Debug.Print aryRes(i) Next End Sub Sub subR(ByVal aryR As Variant) Dim i As Long, j As Long, k As Long ReDim aryTmp((UBound(aryR) + 1) * (UBound(aryOrg) + 1) - 1) For i = 0 To UBound(aryR) For j = 0 To UBound(aryOrg) aryTmp(k) = CCur(aryR(i) + aryOrg(j)) k = k + 1 Next Next End Sub 小数点以下下4桁までの倍精度浮動小数点型の演算誤差を保証しています。 もうボロが出ませんように。
その他の回答 (9)
- nicotinism
- ベストアンサー率70% (1019/1452)
>演算誤差を避けるために、Ccur 関数で通貨型に変更しているためです。 たとえば、イミディエイトウィンドウで ?2.2+2.2+2.2=0+3.3+3.3 とすると、False(左辺と右辺が異なる)が返ります。 ?1.2-0.2-1 だと0にはならずに -5.55111512312578E-17 これを避けるためにCcur関数を使用しています。 分かりやすい説明がこちらにあります。時間を割いてご覧ください。 http://pc.nikkeibp.co.jp/pc21/special/gosa/
- nicotinism
- ベストアンサー率70% (1019/1452)
さっそくボロが出た (^^ゞ myMatch = False For k = 0 To UBound(aryRes) If aryRes(k) = aryTmp(i) Then myMatch = True End If Next のところを myMatch = False For k = 0 To UBound(aryRes) If IsEmpty(aryRes(k)) = False And aryRes(k) = aryTmp(i) Then myMatch = True End If Next にしてください。
補足
何度もありがとうございます。 やはり重複が出ます。 たとえば、 Const rp = 3 '系列数 aryOrg = Array(0, 1.1, 2.2, 3.3, 4.4, 5.5) の場合です。
- nicotinism
- ベストアンサー率70% (1019/1452)
面白そうだったので Option Explicit Private aryOrg As Variant Private aryTmp As Variant Sub main() Const rp = 3 '系列数 aryOrg = Array(1, 2, 3, 4, 5) '種データ Dim aryRes() As Variant Dim i As Long, j As Long, k As Long Dim myMatch As Boolean aryTmp = aryOrg '全ての組み合わせを再帰的に取得 For i = 1 To rp - 1 Call subR(aryTmp) Next '重複を排除し配列に格納 ReDim aryRes(0) For i = 0 To UBound(aryTmp) myMatch = False For k = 0 To UBound(aryRes) If aryRes(k) = aryTmp(i) Then myMatch = True End If Next If myMatch = False Then aryRes(j) = aryTmp(i) j = j + 1 ReDim Preserve aryRes(j) End If Next For i = 0 To UBound(aryRes) Debug.Print aryRes(i) Next End Sub Sub subR(ByVal aryR As Variant) Dim i As Long, j As Long, k As Long ReDim aryTmp((UBound(aryR) + 1) * (UBound(aryOrg) + 1) - 1) For i = 0 To UBound(aryR) For j = 0 To UBound(aryOrg) aryTmp(k) = aryR(i) + aryOrg(j) ' Debug.Print k, aryTmp(k) k = k + 1 Next Next End Sub Accessならクエリの直積であっという間の事なのですけど。 無理無理のごり押しコードですが、一応動きました。 ご参考まで。
お礼
回答ありがとうございます。 すばらしいの一言です。 理解の範囲を完全に逸脱していますが、何とか実行することができました。 ほぼ、希望の動作どおりですが、データに0が入っているときに、結果に0が出力され ませんでした。 たとえば、0,1,2,3を種データとした場合、結果の一番上は0となるはずですが・・・ 理解できないのでどこをどう修正したらよいかわかりません。 よろしくお願いいたします。
補足
よく調べたら、不完全でした。 おそらく、整数のみでしたら問題なさそうですが、小数交じりだと重複が多数発生しました。 たとえば、 Const rp = 3 '系列数 aryOrg = Array(1.1, 2.2, 3.3, 4.4) '種データ とし、 最後の部分のForを For i = 0 To UBound(aryRes) Debug.Print aryRes(i) Cells(i + 1, 1) = aryRes(i) Next として結果をセルに書き出すようにして実行すると、 重複された結果が出てしまいます。 やはり、小数が入ると難しいのでしょうか。
- mt2008
- ベストアンサー率52% (885/1701)
ANo.4です。 > 正直、自分の理解の範囲を超えているのですが、データを > 小数に対応するにはどうすればいいのでしょうか。 私のやり方では少数には対応できません。 この方法は、足し算した時の最大値(例:6)を求め、0~最大値までの配列を用意(nSum(0)~nSum(6))。ループを回して全パターンの足し算を実行し、その答えの番の配列にTrueを入れています(足し算の答え:2→nSum(2)=True)。 で、最後に配列の内、Trueになっている物だけを抜き出しています。 nSum(0)=False nSum(1)=False nSum(2)=True nSum(3)=True nSum(4)=True nSum(5)=True nSum(6)=True ↓ 2,3,4,5,6 つまり、足し算の答えが少数になることは想定していません。 答えが小数点以下2桁等に決まっているのなら100倍等して整数にすることで対応はできます。
- tom04
- ベストアンサー率49% (2537/5117)
No.2・3です。 おそらく当方の勘違いのような気がします。 Sheet1が↓の画像のような配置になっていて、 すべての列毎の組み合わせの和で、重複しないものをSheet2のA列に表示するようなコードでした。 画像で説明すると 1+5 1+6 1+7 1+8 2+5 2+6 2+7 2+8 ・・・4+7 4+8 5+9 5+10 5+11 5+12 6+9 6+10 6+11 ・・・8+11 8+12 とすべての和をSheet2A列に表示させ、重複分を削除・昇順に並び替え! という内容でした。 ※ 系列等を考えず、単にSheet1の表を順に舐めるように加えているだけです。 (何列あっても対応できるように・・・) 的外れならごめんなさいね。m(_ _)m
お礼
回答ありがとうございます。 画像の例ですと、3データ×3系列ですので、足し合わせる数も3つずつになります。 縦を系列のデータ、横を系列と考えると、 ほしい結果は、 1+5+9 1+5+10 1+5+11 1+5+12 1+6+9 1+6+10 1+6+11 1+6+12 1+7+9 ・・・ 4+8+11 4+8+12 で、これらすべての結果から重複を排除したいのです。 よろしくお願いします。
補足
お礼の訂正です。 誤 >画像の例ですと、3データ×3系列 正 画像の例ですと、4データ×3系列
- mt2008
- ベストアンサー率52% (885/1701)
この手のものはループをたくさん回すことになるのでデータ数や系列数が大きくなるとやたら時間がかかるようになりますよ。 コード中のnData にデータを、nKeiretsu に系列数を入れてください。 結果は配列でほしいとの事ですが、わかりやすくするため、A列にも吐き出しています。 Sub Sample() Dim nData() Dim nKeiretsu, nIndex, nMax, nRtn, nPos, i, j, k Dim nSum() As Boolean Dim nReturn() As Long '結果が入る配列 nData = Array(1, 2, 3) '←データ nKeiretsu = 2 '←系列数 nIndex = UBound(nData) + 1 nMax = Application.WorksheetFunction.Max(nData) * nKeiretsu ReDim nSum(nMax) For i = 1 To (nIndex ^ nKeiretsu) nRtn = 0 For j = 0 To (nKeiretsu - 1) nTarget = 1 + Application.WorksheetFunction.RoundUp((i + 1 * (j = 0)) / (nIndex ^ j), 0) Mod nIndex nRtn = nRtn + nData(nTarget - 1) Next j nSum(nRtn) = True Next i '結果を配列に nPos = 0 For k = 0 To nMax If nSum(k) = True Then ReDim Preserve nReturn(nPos) nReturn(nPos) = k nPos = nPos + 1 End If Next k '配列の結果をA列に表示(ついで) For i = 1 To nPos Cells(i, 1) = nReturn(i - 1) Next i End Sub
お礼
回答ありがとうございます。 一番自分の希望のコードに近い感じです。 正直、自分の理解の範囲を超えているのですが、データを 小数に対応するにはどうすればいいのでしょうか。 ためしに、 Dim nData() を、Dim nData() as double にしても駄目でした。
- tom04
- ベストアンサー率49% (2537/5117)
No.1・2です! 何度もごめんなさい。 前回(No.2)のコードで間違いがありました。 もう一度訂正させてください。 そして、余計なお世話かもしれませんが、Sheet2の表示を昇順にしてみました。 Sub test() Dim i, j, k, L, M As Long Dim ws As Worksheet Set ws = Worksheets(2) Application.ScreenUpdating = False ws.Columns(1).ClearContents M = Cells(1, Columns.Count).End(xlToLeft).Column For j = 1 To M - 1 For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row For k = j + 1 To M For L = 1 To Cells(Rows.Count, 1).End(xlUp).Row ws.Cells(Rows.Count, 1).End(xlUp).Offset(1) = Cells(i, j) + Cells(L, k) Next L Next k Next i Next j For i = ws.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1 If WorksheetFunction.CountIf(ws.Columns(1), ws.Cells(i, 1)) > 1 Then ws.Cells(i, 1).Delete (xlUp) End If Next i ws.Cells(1, 1).Delete (xlUp) ws.Columns(1).Sort key1:=ws.Cells(1, 1), order1:=xlAscending Application.ScreenUpdating = True End Sub 今度はお役にたてますかね?m(_ _)m
お礼
いろいろ回答ありがとうございます。 少々自分の理解の範囲を超えているのですが、これは系列数、 系列のデータ数の可変に対応しているのでしょうか? パラメータ(系列数、系列のデータ)をどのように渡せばいいのでしょうか。 データはA1、B1,・・・のように入れていけばいいと思いますが、 系列数はどのように指定すればいいですか?
- tom04
- ベストアンサー率49% (2537/5117)
No.1です! たびたびごめんなさい。 前回は質問内容を取り違えていたようでごめんなさい。 今回はSheet1のデータをSheet2のA列に表示するようにしてみました。 Sheet1のデータはA1セルから入っているとします。 Sub test() Dim i, j, k, L, M As Long Dim ws As Worksheet Set ws = Worksheets(2) Application.ScreenUpdating = False ws.Columns(1).ClearContents M = Cells(1, Columns.Count).End(xlToLeft).Column For j = 1 To M - 1 For k = 2 To M For L = 1 To Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row ws.Cells(Rows.Count, 1).End(xlUp).Offset(1) = Cells(i, j) + Cells(L, k) Next i Next L Next k Next j For i = ws.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1 If WorksheetFunction.CountIf(ws.Columns(1), ws.Cells(i, 1)) > 1 Then ws.Cells(i, 1).Delete (xlUp) End If Next i ws.Cells(1, 1).Delete (xlUp) Application.ScreenUpdating = True End Sub こんな感じではどうでしょうか? ※ 検証していませんので、ご希望通りでなかったら ごめんなさいね。m(_ _)m
- tom04
- ベストアンサー率49% (2537/5117)
こんばんは! 一例です。 各系列はA・B列の1行目からあり、結果をC1セル以降に表示させるとします。 Sub test() Dim i, j As Long Application.ScreenUpdating = False Columns(3).ClearContents For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row For j = 1 To Cells(Rows.Count, 2).End(xlUp).Row Cells(Rows.Count, 3).End(xlUp).Offset(1) = Cells(i, 1) + Cells(j, 2) Next j Next i For i = Cells(Rows.Count, 3).End(xlUp).Row To 2 Step -1 If WorksheetFunction.CountIf(Range(Cells(2, 3), Cells(i, 3)), Cells(i, 3)) > 1 Then Cells(i, 3).Delete (xlUp) End If Next i Cells(1, 3).Delete (xlUp) Application.ScreenUpdating = True End Sub ※ A・B列のデータ数が違っても対応できると思います。 他に良い方法があればごめんなさいね。m(_ _)m
補足
回答ありがとうございます。 書き忘れて申し訳ありませんでしたが、系列が2個なら(限定されていれば)自分でも 記述できます。 ただし、限定されているからといって、系列が2個や3個程度ならForの入れ子を2個、3個で すみますが、5個10個それ以上になると現実的ではありません。 系列数は動的にしたいのです。 系列内の数字(1,2,3など)はある程度決まっているのですが…。 できればセルにいちいち書き出さず、配列などを利用して実現できないかと考えています。 よろしくお願いします。
関連するQ&A
- Excelですべての組合せ(重複組合せ)を出力するには?
Excelですべての組合せ(重複組合せ)を出力するには? 次の条件のような場合、Excelですべての組合せ(重複組合せ)をVBAで出力するにはどうしたらいいのでしょうか? 10種類のお菓子の中から、好きなものを3個選んでセットにするとします。 同じものを複数選ぶのはありですが「菓子A、菓子B、菓子C」と「菓子B、菓子C、菓子A」は選んだ順が違うだけで同じ組合せなので、どちらか片方だけにします。 この場合、すべての組合せの数は Excelの関数で求めることができるようで COMBIN(10+3-1,3) = 220 通りあることまではわかりましたが、このすべての組合せの一覧をどのようにして出力したらいいのかがわかりません。 いろいろ検索した結果、順列という方法は見つかりましたが、重複組合せでの方法は見つけることができませんでした。 また、Accessを使っても似たようなことができるのでしょうか? 直積? できれば、3個固定ではなく5個の場合も出来るとうれしいです。 よろしくお願いします。
- ベストアンサー
- Visual Basic
- エクセル・解がある数字になるように足し算する数字を選ぶ方法
いくつかの数字が並んでいて、その中から選んで足し算をします。 その足し算の答えがある範囲内に当てはまるような組み合わせを全部求めたいと思います。 分かりにくいので具体例を書きます。 0.5 1.1 1.8 2.3 3.8 4.2 上記の6個の数字からいくつか選んで足した結果が4.9~5.9になる組み合わせをすべて求めたいです。 この場合、 0.5+1.1+1.8+2.3=5.7 1.1+1.8+2.3=5.2 4.2+0.5=4.7 4.2+1.1=5.3 4.2+1.1+0.5=5.8 3.8+1.8=5.6 3.8+1.1=4.9 3.8+1.1+0.5=5.4 の8種類(もっとあったらごめんなさい)になると思います。 この8種類を書き出したいのですが、うまい方法が思い浮かびません。 ソルバーとかなのかと思って調べてみたのですが、計算式が確定していない場合は使えないみたいです。 やっぱりVBAを使わないと難しいでしょうか? なんとか簡単にできる方法があれば、アドバイス下さい。 よろしくお願いいたします。
- ベストアンサー
- オフィス系ソフト
- ナンバーズ3、4の重複しないシングルの組み合わせ
どなたかご存じでしたら回答をお願いします。 数字選択式宝くじのナンバーズ4の組み合わせは、 0000~9999までの10000通りあります。 この中で、全ての数字が異なる組み合わせは 5040通り(10×9×8×7)あると思います。 これを、「重複しないシングル組み合わせ」は 210通り(5040÷(4×3×2×1))になるかと思います。 この210通りの全ての組み合わせをエクセルで作りたいのですが、 作り方が分かりません。 同様に、ナンバーズ3については、000~999までの1000通りの 組み合わせの中から、全ての数字が異なる組み合わせは 720通り(10×9×8)あると思います。 これを、「重複しないシングル組み合わせ」は 120通り(720÷(3×2×1))の全て組み合わせをエクセルで作りたいのですが、 作り方が分かりません。 120 通りと240通りなのでエクセル又はエクセルVBAでの作り方を教えてください。 よろしくお願いします。
- ベストアンサー
- 数学・算数
- 順列・組合わせの問題。
ある問題集に、こんな問題がありました。 【生徒9人を、3人ずつの組A,B,Cに分けるとする。 この組分けで、特定の2人が同じ組に入る場合は 何通りありますか。】 さて私は、特定の2人ってことは、それをひとくくりにして、 この問題を次のように読み替えてみました。 【生徒8人を、A,B,Cの組に分ける。 1つの組は2人となり、あとの2つの組は3人ずつ入るものとする。 この場合、何通りの組み合わせが考えられるか。】 そして、次のように解いてみました。 ____________________________ 生徒8人を、3/3/2に分ける。 まず、8人から3人を選ぶ組み合わせは、8C3通り。 次に、残りの5人から3人を選ぶ組み合わせは、5C3通り。 のこりの組み合わせは1通りと決まっているから、 8C3×5C3=560(通り) ____________________________ あるいは、同じことですが、 ____________________________ まず、8人から2人を選ぶ組み合わせは、8C2通り。 次に、残りの6人から3人を選ぶ組み合わせは、6C3通り。 のこりの組み合わせは1通りに決まっているから、 8C2×6C3=560(通り) ____________________________ ところが、正解は420通りでした。(T^T) 解答を見れば、その導き出し方は理解できました。 私が知りたいのは、 私の解答法のどこが間違っていて、 具体的にどういった場合を重複して数えてしまっているのか、 その具体例です。 当方、数学はド素人で、ただ好きで問題集を覗いているだけです。 基本的な質問ですみませんが、どなたか分かりやすく教えてください。
- ベストアンサー
- 数学・算数
- エクセルでの足し算(特定数を除きたい)
エクセルでの足し算(特定数を除きたい) 行/セル A B C ・・・・ 1 1 3 7 2 2 1 1 3 3 2 1 上記のように一桁の数字が入ったデータがあるのですが、 このA~Cを足し算するときに、「7以上」の数字は足し算させたくありません。 例: 1行目・・・ A1+B2 = 4 (C1は無視) このような場合はどのような指定をすれば良いでしょうか。
- ベストアンサー
- その他MS Office製品
- 重複組合せ
重複組合せの問題がどうも理解できないのでお願いします。 問い: 一つのさいころを二回投げて出た目を順にa,bとする時a≧bとなるような目の出 方は何通りあるか。重複組合せの考え方で解け ---- これはどういう風に考えればいいのでしょう。 重複組合せは「○○○○○○と|」という具合に「○の数と頭数-1の仕切」で考えるんですよね。 題意に沿うようにaとbを表に整理すると、 a=1 b=1 a=2 b=1,2 a=3 b=1,2,3 a=4 b=1,2,3,4 a=5 b=1,2,3,4,5 a=6 b=1,2,3,4,5,6 このようになりますが、これを「○の数と頭数-1の仕切」やnHrの形で表すのに どのように考えて良いのか分かりません。 さいころの目は常にn≧1なので、さいころの目を六個のボールと考えて 「aさんが0個のボールを手にするとき、bさんは6個手にすることが出来る」 「aさんが1個のボールを手にするとき、bさんは5個手にすることが出来る」 ・・・ などというようには考えられないのですが・・・。 そもそも重複組合せの私の理解が間違っているのでしょうか。 お願いします。
- ベストアンサー
- 数学・算数
- ACCESS2007 クエリで足し算したいができない。
クエリで、足し算をしたいのですができません。 例えば、A+B=Cをしたいのですが、クエリ内でAとBが0のデータが空白になってしまっていて、足し算ができません。 AとBに数字が入っている場合は、足されています。 規定値を0に設定すればいいみたいですが、それがわかりません。 規定値を0に設定とはどうやるのですか? 元になっているテーブルに設定するのですか? クエリの方に設定するのですか?
- ベストアンサー
- Windows XP
- Perlで足し算をするには
Perl 初心者です。 いい足し算ができず、困っています。my $Aの数字を足していくだけなのですが、 うまくいきません。 何が悪いのかわかる方教えてください。 よろしくお願いいたします。 Perlではsumをつかわないでしょうか? 下記は4と2と3なので、9になるはずなのですが。。。。 その1 my $A = 4,2,3; $B = (sum($A)); print "$B" その2 my $A = 4,2,3; $B = subsum($A); print "$B"
- 締切済み
- Perl
- エクセルでnCr (組み合わせ)の作成方法
どなたかご存じでしたら回答願います。 ミニロトとロト6をエクセルを使用して予想に利用しております。 その中で知りたいのは、下記の場合のエクセルVBAのソースです。 ●知りたいこと。 (1)ミニロトの場合は、31個から5個全てが一致すると一等ですが、 「25個から5個選択した場合の組み合わせ(25C5)」作成方法 (2)ロト6の場合は、43個から6個全てが一致すると一等ですが、 「24個から6個選択した場合の組み合わせ(24C6)」作成方法。 ●入力 (1)ミニロトの場合は、下記のように5×5マスに重複しない数字が入っています。 数字は毎回変わります。 1 2 5 6 7 10 4 11 13 15 8 9 17 21 28 14 16 18 20 25 19 22 23 24 27 (2)ロト6の場合は、下記のように6×4マスに重複しない数字が入っています。 数字は毎回変わります。 1 2 5 6 7 19 10 4 11 13 5 22 8 9 17 21 28 23 14 16 18 20 25 24 ●出力 VBAを実行すると、新シートにそれぞれ、25C5又は、24C6の全組み合わせが出力される。 【注意事項】 ・使用しているエクセルは2010です。 以上、ご回答よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
補足
すばらしいです。 たぶんもう大丈夫です。 でも、なぜか結果をセルに出力したとき、\マークが表示される 用になってしまいましたが…(笑) 結果をセルに書き出すことが最終目標ではないので問題ありませんが。