VBA練習問題
VBA100本ノック 魔球編:組み合わせ問題

VBAを100本の練習問題で鍛えます
公開日:2020-12-02 最終更新日:2020-12-18

VBA100本ノック 魔球編:組み合わせ問題


5つの数字から決められた数値合計に最も近くなる組み合わせを求める問題です。


ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。


出題

出題ツイートへのリンク

#VBA100本ノック 魔球編
5つの数値を引数で受け取ります。
数値は正の整数(重さg)です。
20~40(g)まで幅があります。
この中から100gを超える100gに最も近い組み合わせを見つけて、その組み合わせを配列で返してください。
お菓子の定量詰めと考えてください。
組み合わせる個数に制限はありません。


VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。


他の人の回答および解説を見て、書いたVBAを見直してみましょう。


頂いた回答

解答

沢山の回答が寄せられて、もうそれで充分なのですが、
出題者の責任として、一応コードを出しておきます。
やってることは同じですが、一応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を書いたときのテスト用として使ったものです。

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本ノック」の記事

95本目:図形のテキストを検索するフォーム作成
96本目:Accessデータを取得(マスタ結合&抽出)
97本目:Accessデータを取得(グループ集計)
98本目:席替えルールが守られているか確認
99本目:自動席替え(行列と前後左右が全て違うように)
100本目:WEBから100本ノックのリストを取得
魔球編:組み合わせ問題
魔球編:閉領域の塗り潰し
迷宮編:巡回セル問題
魔球編:2桁の最小公倍数
参加者様ご紹介


新着記事NEW ・・・新着記事一覧を見る

VBA10大躓きポイント(初心者が躓きやすいポイント)|VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成|ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。|エクセル雑感(2024-02-17)
初級脱出10問パック|VBA練習問題(2024-01-24)
累計を求める数式あれこれ|エクセル関数応用(2024-01-22)
複数の文字列を検索して置換するSUBSTITUTE|エクセル入門(2024-01-03)
いくつかの数式の計算中にリソース不足になりました。|エクセル雑感(2023-12-28)
VBAでクリップボードへ文字列を送信・取得する3つの方法|VBA技術解説(2023-12-07)
難しい数式とは何か?|エクセル雑感(2023-12-07)
スピらない スピル数式 スピらせる|エクセル雑感(2023-12-06)


アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
4.繰り返し処理(For Next)|VBA入門
5.変数宣言のDimとデータ型|VBA入門
6.ブックを閉じる・保存(Close,Save,SaveAs)|VBA入門
7.並べ替え(Sort)|VBA入門
8.条件分岐(IF)|VBA入門
9.セルのクリア(Clear,ClearContents)|VBA入門
10.マクロとは?VBAとは?VBAでできること|VBA入門




このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。



このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
本文下部へ