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

VBAを100本の練習問題で鍛えます
最終更新日: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本ノック」の記事

93本目:複数ブックを連結して再分割
94本目:表範囲からHTMLのtableタグを作成
95本目:図形のテキストを検索するフォーム作成
96本目:Accessデータを取得(マスタ結合&抽出)
97本目:Accessデータを取得(グループ集計)
98本目:席替えルールが守られているか確認
99本目:自動席替え(行列と前後左右が全て違うように)
100本目:WEBから100本ノックのリストを取得
魔球編:組み合わせ問題
魔球編:閉領域の塗り潰し
迷宮編:巡回セル問題


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

VLOOKUPを使うことを基本としてシートを設計すべきか|エクセル雑感(2021-08-17)
コンピューターはブラックボックスで良い|エクセル雑感(2021-08-14)
小文字"abc"を大文字"ABC"に変換する方法|エクセル雑感(2021-08-13)
ADOでテキストデータを集計する|VBAサンプル集(2021-08-04)
VBA学習のお勧めコース|エクセル雑感(2021-08-01)
エクセル馬名ダービー|エクセル雑感(2021-07-21)
在庫を減らせ!毎日棚卸ししろ!|エクセル雑感(2021-07-05)
日付型と通貨型のValueとValue2について|エクセル雑感(2021-06-26)
DXってなんだ? ITと何が違うの?|エクセル雑感(2021-06-24)
エクセルVBA 段級位 目安|エクセル雑感(2021-06-21)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.Excelショートカットキー一覧|Excelリファレンス
3.変数宣言のDimとデータ型|VBA入門
4.RangeとCellsの使い方|VBA入門
5.繰り返し処理(For Next)|VBA入門
6.マクロって何?VBAって何?|VBA入門
7.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
8.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
9.セルに文字を入れるとは(Range,Value)|VBA入門
10.とにかく書いてみよう(Sub,End Sub)|VBA入門




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


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



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