VBA100本ノック 魔球編：組み合わせ問題
5つの数字から決められた数値合計に最も近くなる組み合わせを求める問題です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。
出題
出題ツイートへのリンク
#VBA100本ノック 魔球編
5つの数値を引数で受け取ります。
数値は正の整数(重さg)です。
20~40(g)まで幅があります。
この中から100gを超える100gに最も近い組み合わせを見つけて、その組み合わせを配列で返してください。
お菓子の定量詰めと考えてください。
組み合わせる個数に制限はありません。
5つの数値を引数で受け取ります。
数値は正の整数(重さg)です。
20~40(g)まで幅があります。
この中から100gを超える100gに最も近い組み合わせを見つけて、その組み合わせを配列で返してください。
お菓子の定量詰めと考えてください。
組み合わせる個数に制限はありません。
VBA作成タイム
この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。
他の人の回答および解説を見て、書いたVBAを見直してみましょう。
頂いた回答
解答
沢山の回答が寄せられて、もうそれで充分なのですが、
出題者の責任として、一応コードを出しておきます。
やってることは同じですが、一応2通り書きました。
最初の方は、選んだ数値だけを配列にしています。
後者は、常に5つの配列を返し、使用しない数値は0にしています。
出題者の責任として、一応コードを出しておきます。
やってることは同じですが、一応2通り書きました。
Function VBA100_魔球編1_01(ary, Optional TargetNum = 100) As Variant
Dim ansBin As String, tmpBin As String
Dim total As Long, tt As Long
Dim i As Long, j As Long, cnt As Long
cnt = UBound(ary) - LBound(ary) + 1
total = WorksheetFunction.Sum(ary) + 1
For i = 1 To 2 ^ cnt - 1
tmpBin = WorksheetFunction.Dec2Bin(i, cnt)
tt = 0
For j = LBound(ary) To UBound(ary)
tt = tt + (ary(j) * Mid(tmpBin, j - LBound(ary) + 1, 1))
Next
If tt > TargetNum And tt < total Then
total = tt
ansBin = tmpBin
End If
Next
If ansBin = "" Then Exit Function
Dim ans() As Long
i = 1
For j = LBound(ary) To UBound(ary)
If Mid(ansBin, j - LBound(ary) + 1, 1) = "1" Then
ReDim Preserve ans(1 To i)
ans(i) = ary(j)
i = i + 1
End If
Next
VBA100_魔球編1_01 = ans
End Function
Function VBA100_魔球編1_02(ary, Optional TargetNum = 100) As Variant
Dim ary2, tAry, ansAry
Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long, i5 As Long
Dim total As Long, tt As Long
ary2 = ary
ReDim Preserve ary2(1 To UBound(ary) - LBound(ary) + 1)
tAry = ary2
total = WorksheetFunction.Sum(ary) + 1
For i1 = 0 To 1
tAry(1) = ary2(1) * i1
For i2 = 0 To 1
tAry(2) = ary2(2) * i2
For i3 = 0 To 1
tAry(3) = ary2(3) * i3
For i4 = 0 To 1
tAry(4) = ary2(4) * i4
For i5 = 0 To 1
tAry(5) = ary2(5) * i5
tt = WorksheetFunction.Sum(tAry)
If tt > TargetNum And tt < total Then
total = tt
ansAry = tAry
End If
Next
Next
Next
Next
Next
VBA100_魔球編1_02 = ansAry
End Function
最初の方は、選んだ数値だけを配列にしています。
後者は、常に5つの配列を返し、使用しない数値は0にしています。
補足
寄せられた回答にも多くありましたが、
5つの数値のそれぞれを使うか使わないかの2択なので、これを0,1で表現。
全通りは2^5-1です。
これは2進数であらわすと、
00001
00010
00011
00100
・・・
11101
11110
11111
これで31通り全ての組み合わせになります。
このビットの1に対応する配列の位置の数値を使って合計して、100を超えるか判定し100を超えている場合はそれまでの数値より小さいか判定しています。
後者のVBAも結局は同じ考えになりますが、
5つ限定なら5重ループさせてしまえということで、ループごとに数値を使う場合・使わない場合を計算しています。
普段のVBAでこのような処理をすることはあまりないと思いますが、
勉強がてら、一度くらいはこのような処理も書いてみるのも良いと思います。
スピルで簡単に確認する場合の、ユーザー定義関数は以下になります。
VBAを書いたときのテスト用として使ったものです。
5つの数値のそれぞれを使うか使わないかの2択なので、これを0,1で表現。
全通りは2^5-1です。
これは2進数であらわすと、
00010
00011
00100
・・・
11101
11110
11111
このビットの1に対応する配列の位置の数値を使って合計して、100を超えるか判定し100を超えている場合はそれまでの数値より小さいか判定しています。
5つ限定なら5重ループさせてしまえということで、ループごとに数値を使う場合・使わない場合を計算しています。
勉強がてら、一度くらいはこのような処理も書いてみるのも良いと思います。
VBAを書いたときのテスト用として使ったものです。
Function VBA100MAGIC(rng, Optional TargetNum = 100)
Dim ary, i
ReDim ary(1 To rng.Count)
For i = 1 To rng.Count
ary(i) = rng(i).Value
Next
With WorksheetFunction
VBA100MAGIC = .Transpose(.Transpose(VBA100_魔球編1_02(ary, TargetNum)))
End With
End Function
同じテーマ「VBA100本ノック」の記事
・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
96本目：Accessデータを取得（マスタ結合&抽出）・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
97本目：Accessデータを取得（グループ集計）・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
98本目：席替えルールが守られているか確認・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
99本目：自動席替え（行列と前後左右が全て違うように）・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
100本目：WEBから100本ノックのリストを取得・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
魔球編：組み合わせ問題魔球編：閉領域の塗り潰し
・出題 ・頂いた回答 ・解答 ・解答VBAコード
迷宮編：巡回セル問題・出題 ・頂いた回答 ・解答VBAコードの解説 ・解答VBAコード ・中間地点数10個～15個での処理時間比較
魔球編：2桁の最小公倍数・出題 ・頂いた回答 ・解答 ・解答VBAコード
参加者様ご紹介・ツイッターの引用リツイート等で回答されている方 ・YouTubeで回答または解説されている方 ・ブログ等で回答または解説されている方
新着記事NEW ・・・新着記事一覧を見る
TRIMRANGE関数（セル範囲をトリム：端の空白セルを除外）｜エクセル入門(2024-08-30)
正規表現関数（REGEXTEST,REGEXREPLACE,REGEXEXTRACT）｜エクセル入門(2024-07-02)
エクセルが起動しない、Excelが立ち上がらない｜エクセル雑感(2024-04-11)
ブール型（Boolean）のis変数・フラグについて｜VBA技術解説(2024-04-05)
テキストの内容によって図形を削除する｜VBA技術解説(2024-04-02)
ExcelマクロVBA入門目次｜エクセルの神髄(2024-03-20)
VBA10大躓きポイント（初心者が躓きやすいポイント）｜VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成｜ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。｜エクセル雑感(2024-02-17)
初級脱出10問パック｜VBA練習問題(2024-01-24)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.変数宣言のDimとデータ型｜VBA入門
4.繰り返し処理（For Next)｜VBA入門
5.RangeとCellsの使い方｜VBA入門
6.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
7.セルのクリア（Clear,ClearContents）｜VBA入門
8.メッセージボックス(MsgBox関数)｜VBA入門
9.条件分岐（Select Case）｜VBA入門
10.マクロとは？VBAとは？VBAでできること｜VBA入門
- ホーム
- マクロVBA入門編
- VBA100本ノック
- 魔球編：組み合わせ問題
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。