いくつかの数字が並んでいて、その中から選んで足し算をします。
その足し算の答えがある範囲内に当てはまるような組み合わせを全部求めたいと思います。
分かりにくいので具体例を書きます。
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を使わないと難しいでしょうか?
なんとか簡単にできる方法があれば、アドバイス下さい。
よろしくお願いいたします。
No.2ベストアンサー
- 回答日時:
>上記の6個の数字からいくつか選んで足した結果が4.9~5.9になる組み合わせをすべて求めたいです。
なら、
4.2+0.5=4.7
これは、範囲外だよね!!
組合せの最適化をすれば、もっと速いコードもありそうですが・・・。
新規ブックの標準モジュール(Module1)に
'========================================================
Sub main()
Dim 組合せセル範囲 As Range
Dim 抜き取り数 As Long
Dim asum As Double
Dim 合計1 As Double
Dim 合計2 As Double
Dim d_rw As Long
Range("a1:a6").Value = [{0.5;1.1;1.8;2.3;3.8;4.2}]
MsgBox "サンプルデータをA列に設定"
合計1 = 4.9
合計2 = 5.9
d_rw = 1
Set 組合せセル範囲 = Range("a1", Cells(Rows.Count, "a").End(xlUp))
組合せセル範囲.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo
For 抜き取り数 = 1 To 組合せセル範囲.Count
Call init_comb(組合せセル範囲, 抜き取り数)
ReDim ans(1 To 抜き取り数)
Do While get_comb(ans()) = 0
asum = Application.Sum(ans())
If asum >= 合計1 And asum <= 合計2 Then
Range(Cells(d_rw, 3), Cells(d_rw, 抜き取り数 + 2)).Value = ans()
d_rw = d_rw + 1
ElseIf asum > 合計2 Then
skip_comb
End If
Loop
Next
MsgBox "以上、" & d_rw - 1 & " 通り検出しました"
End Sub
別の標準モジュールに(Module2)に
組合せリスト作成ルーチン
'===========================================================
Option Explicit
Private c_svn As Long '抜き取り数保存
Private c_myarray() '組合せ対象値の配列
Private c_idx() As Long '配列のカレントポインタ
Private cs_x() As Long '配列の基盤ポインタ
'=======================================
Function init_comb(rng As Range, seln As Long) As Double
Dim i As Long
Dim crng As Range
c_svn = seln
Erase c_myarray()
Erase c_idx()
Erase cs_x()
i = 1
ReDim Preserve c_myarray(1 To rng.Count)
For Each crng In rng
c_myarray(i) = crng.Value
i = i + 1
Next
ReDim cs_x(1 To seln)
ReDim c_idx(1 To seln)
For i = 1 To UBound(c_idx())
cs_x(i) = i
c_idx(i) = i
Next
c_idx(UBound(c_idx())) = c_idx(UBound(c_idx())) - 1
init_comb = WorksheetFunction.Combin(rng.Count, seln)
End Function
'=======================================
Function get_comb(ans()) As Long
Dim i As Long
Dim j As Long
get_comb = 1
For i = UBound(c_idx()) To LBound(c_idx()) Step -1
If c_idx(i) + 1 <= UBound(c_myarray()) - c_svn + i Then
c_idx(i) = c_idx(i) + 1
get_comb = 0
Exit For
Else
c_idx(i) = cs_x(i) + 1
cs_x(i) = cs_x(i) + 1
For j = i + 1 To UBound(cs_x())
cs_x(j) = cs_x(j - 1) + 1
c_idx(j) = cs_x(j)
Next j
End If
Next
If get_comb = 0 Then
For i = LBound(c_idx()) To UBound(c_idx())
ans(i) = c_myarray(c_idx(i))
Next
End If
End Function
'=======================================
Function skip_comb()
Dim i As Long
For i = UBound(c_idx()) To LBound(c_idx()) + 1 Step -1
If c_idx(i) <> c_idx(i - 1) + 1 Then
c_idx(i) = UBound(c_myarray()) - c_svn + i
Exit For
End If
c_idx(i) = UBound(c_myarray()) - c_svn + i
Next
End Function
'=======================================
Sub close_comb()
Erase c_myarray()
Erase c_idx()
Erase cs_x()
End Sub
として、適当なシート(何も入力されていない)でmainを
実行してみてください。セルC1から条件にあった組合せを
表示します。
ありがとうございますー(T-T)
おっしゃるとおり、4.7は範囲外でした(^-^;
lark_0925様にいただいたコードを使ってみたら、理想通りの結果を得ることができました!
総当たりで足し算をしたとしても、その足している数字が何なのかを全部書き出すにはどうすれば…と思っていましたが、配列を利用すれば良かったのですね!
配列はなかなか難しくて、自分では使いこなせないのですが、lark_0925様のコードを見てなんとか理解しようと思います。
個人的には「Application.Sum(ans())」で合計を取れるということに感動しました!
それにしてもすごいですね!!!
こんなすぐにコードをかけてしまうなんて、尊敬です。
本当にとてもとても助かりました。
涙が出るほど嬉しいです。本当にありがとうございました。
No.4
- 回答日時:
数個なら。
。。A列にデータがあって、作業列が X~Z列だとして、
X Y Z
1 001010
2 000001 4.2 010001
3 000010 3.8 010010
4 000011 8 011100
5 000100 2.3 110001
6 000101 6.5 110010
7 000110 6.1 111100
:
X2=TEXT(DEC2BIN(ROW(A1)),REPT("0",6))
X64までコピー(64=2^6)。
Y2=SUMPRODUCT($A$1:$A$6,MID(X2,ROW($A$1:$A$6),1)*1)
Y64までコピー。
Y列にオートフィルターで [4.9以上]AND[5.9以下] の条件で抽出。
抽出されたX列のデータをコピー、Z1に[形式を選択して貼り付け]-[値]。
A B C ・・・
1 0.5 0 0
2 1.1 0 1
3 1.8 1 0
4 2.3 0 0
5 3.8 1 0
6 4.2 0 1
7 5.6 5.3
B1=MID(INDEX($Z:$Z,COLUMN(A1)),ROW(A1),1)*1
B6までと、右へコピー。
B7=SUMPRODUCT($A1:$A6,B1:B6)
右へコピー。
1と0 で、その数字を使う使わない の判定にします。7行目は確認用。
B列は 1.8 + 3.8 = 5.6
C列は 1.1 + 4.2 = 5.3
という意味です。
VBA でやるなら、2つ足す場合、3つ足す場合、4つ足す場合・・・
と、やると、遅くなると思います。
総当りはどんな方法でも限界があるでしょうけど。
'データは、A1セルから空白無く、複数あるとする
Sub SoAtari()
'目標値
Const a As Currency = 4.9 '以上
Const z As Currency = 5.9 '以下
Dim n As Integer 'データ数
Dim arr0, arr1() As Currency
Dim b As Long
Dim i As Long, j As Long 'ループ用、使い回し
Dim col As Integer '列番号
With Range("a1")
n = .End(xlDown).Row
arr0 = .Resize(n).Value
.CurrentRegion.Offset(, 1).ClearContents
End With
'全ての組み合わせの和を配列arr1にセット
'全て計算する必要は無いので、改善の余地あり
ReDim arr1(1 To 2 ^ n - 1)
For i = 0 To n - 1
b = 2 ^ i
arr1(b) = CCur(arr0(i + 1, 1))
For j = 1 To b - 1
arr1(b + j) = arr1(b) + arr1(j)
Next j
Next i
col = 2
For i = 1 To 2 ^ n - 1
'目標値の範囲ならシートへ書き込む
If arr1(i) >= a And arr1(i) <= z Then
For j = 0 To n - 1
If i And 2 ^ j Then Cells(j + 1, col).Value = arr0(j + 1, 1)
Next j
Cells(n + 1, col).Value = CDbl(arr1(i))
col = col + 1
End If
Next i
Erase arr0, arr1
End Sub
ありがとうございます!
すごい!!関数でもできるんですね。
0と1を使って使うかどうかの判定をしたり、それを組み合わせで全通り表示する方法など、たぶん一生考えても思いつけそうにありません。
感動しました(T-T)
9個まではちゃんとできました!
10個からは2進数が表示されないみたいでエラーになってしまいました。
VBAの改善とは、上限を超えた場合は計算をしなくても良いということですよね。
でも、試しに動かしてみたら速度に問題なく計算できました!!
結果が一覧になっていてとても見やすかったです。
とてもとても勉強になりました。
やはり配列はちゃんと勉強すればとても役立つのだと思いました。
ありがとうございました!!大感謝です。
No.1
- 回答日時:
類似していると言えば、
http://okwave.jp/qa257719.html
でしょうか。
ただ固定された答えではなく範囲内に入る組み合わせとなると、
もっとやっかいになるように思います。
回答ではなく、すいません。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) VBAで組み合わせ算出やCOUNTIFSの処理を高速化したいです。 4 2022/04/07 02:38
- 労働相談 有給休暇使用時の賃金の計算方法について 5 2022/04/04 00:02
- その他(Microsoft Office) ある表(10桝程度)の中に数字が入っています。ダブっている数字を除く数字の合計数の計算方法 5 2023/02/15 11:33
- その他(お金・保険・資産運用) 至急!【Wolt】各メニューの価格設定の簡単な計算方法 3 2023/03/05 11:58
- Excel(エクセル) SUMIF関数について 4 2023/06/14 13:13
- 数学 時々、回答者の見識に疑念を抱いてしまうんです。私だって本当は皆様のことを疑いたくはありません。しかし 2 2022/11/27 12:23
- Excel(エクセル) Excelシートのある番地の文字が一致したすべての行を別シートに転記する方法 11 2022/10/25 08:43
- 数学 小学生がたった1日で19×19までかんぺきに暗算できる本、のおみやげ算。数学的に言うと何? 3 2023/04/07 09:35
- Excel(エクセル) エクセル関数の変わった使い方 3 2022/05/13 17:12
- 統計学 ガチャガチャの中に、あるアニメの キャラAのフィギュアが3種類1個ずつ キャラBのフィギュアが3種類 1 2022/06/04 15:28
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excelで「時間の足し算」はどう...
-
オートフィルのショートカット...
-
エクセルに詳しい方教えて下さ...
-
勤務表をエクセルで作る際、 最...
-
Excel2010で、今の、Ex...
-
UNIQUE関数が使えないバージョ...
-
Excelについて質問です。 表の...
-
Excelについて質問です。 ・デ...
-
Excelのフォントについて
-
Excel表の文字の幅を狭くしたい
-
Excelについて質問です。
-
エクセルのパスワードの一括解...
-
Excel 2019 での上書き保存につ...
-
EXCELで、関数を使って対象の項...
-
VBA
-
Excelで、10000,20000,30000と...
-
FormulaR1C1の 相対参照式のコピー
-
エクセルのソートについて
-
Excel 連番を入力する方法
-
Excelで投入数、加工数、検査待...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセル詳しい方教えて下さい
-
ExcelでA列をコピーしたいので...
-
エクセルのセル統合について
-
Excelの関数で起きた現象の原因...
-
Excelファイルが閉じられい!
-
Excelのシート背景に不明な文字...
-
エクセルの枠線
-
Excel 領収書発行
-
エクセル関数の使い方を教えて...
-
C列にF列の担当者(A〜)を順番...
-
ピポットテーブルの参照元を別...
-
EXCEl VBA
-
Excelでの判別方法
-
VBAで、サブフォルダにある複数...
-
"りんご"と"みかん"というシー...
-
マクロについて教えてください。
-
EXCELファイルが読み取り専用で...
-
同一セルに入力規則のリストと...
-
100行50列の表で、1~40列でフ...
-
なぜか「Nextに対応するForがあ...
おすすめ情報