
A 回答 (4件)
- 最新から表示
- 回答順に表示
No.4
- 回答日時:
こんにちは
ご希望のようなVBAコードは古くからQAサイトや参考サイトに掲示されていると思います。ドンピシャが無くてもロジックが分かれば改造も容易と思いますよ。
とは言え、具体的なコードが欲しいようですので下記を参考にしてください
1点、私の中で?が付くところがあります。
❶A1・A5
❷A3・A4
❸A2
(上記が答えとして)
A2が登場するのに なぜ A1・A4 は登場しないのでしょうか
A2単体より240gに近いと思うのですが、、、
そのあたりがはっきりしないまま書きますのでご希望と違ていたら
修正してくださいね。追質は勘弁ね
A列に A1・A2・A3・・・(任意の文字アイコン)
B列に 120・150・130・・・(任意の数値)
許容量はコード内
出力はD1セル以下に
ご質問の内容で作ったので他の数値で上手くいくかは、どうでしょう
Option Explicit
Sub sample()
Dim tp As Long, maxV As Long
Dim i As Long, j As Long, n As Long, k As Long
Dim x As Long, y As Integer
Dim cnt As Long, tMax As Long
Dim V(), Ary(), tmp()
maxV = 240
n = Range(Cells(1, 2), Cells(Rows.Count, 2).End(xlUp)).Count
ReDim V(n, 1)
For i = 1 To n
V(i, 0) = Cells(i, 2).value
V(i, 1) = Cells(i, 1).value
If tMax < Cells(i, 2).value And maxV > tMax Then tMax = Cells(i, 2).value
Next
For j = 1 To 2 ^ n - 1
tp = 0
cnt = 1
For k = 1 To n
If j And cnt Then tp = tp + V(k, 0)
cnt = cnt + cnt
Next
If tp <= maxV And tMax <= tp Then
tMax = tp
cnt = 1
For k = 1 To n
If j And cnt Then
ReDim Preserve tmp(1, x)
tmp(y, x) = V(k, 1)
If y = 0 Then y = 1 Else y = 0
End If
cnt = cnt + cnt
Next
x = x + 1
End If
Next
ReDim Ary(UBound(tmp, 2), UBound(tmp, 1))
For i = 0 To UBound(tmp, 1)
For j = 0 To UBound(tmp, 2)
Ary(j, i) = tmp(UBound(tmp, 1) - i, UBound(tmp, 2) - j)
Next
Next
Range("D1").Resize(UBound(Ary, 1) + 1, UBound(Ary, 2) + 1) = Ary
End Sub
No.3
- 回答日時:
こんばんは
一般解としては、No2様のおっしゃるソルバーを利用するのが宜しいように思います。
とは言え、ご提示のように種類数が5組程度であれば、全数の組み合わせで求めても大したことはありませんね。
(2^5=32通りなので)
試みに、無理矢理に関数で求めてみました(笑)
・添付図のA1:A5に元となる数値があるものとします。
(上記の数量は整数値であるものと仮定しています)
・許容量の上限がD1セル
・D3セルが得られる解の合計値
・D4セルがその際の組合せ
(下位の桁から順にA1・・A5セルに相当し、1の値部分に相当するセルを加算していることを示します)
添付図の例では「10001」なので、A1とA5を加算して240になっているということになります。
関数式として、
D3セルには、
=AGGREGATE(14,6,(MMULT((BITAND(ROW(A1:A31),{1,2,4,8,16})>0)*1,A1:A5))/(MMULT((BITAND(ROW(A1:A31),{1,2,4,8,16})>0)*1,A1:A5)-D1<=0),1)
D4セルには、
=RIGHT("0000"&DEC2BIN(MOD(AGGREGATE(14,6,(MMULT((BITAND(ROW(A1:A31),{1,2,4,8,16})>0)*1,A1:A5)+ROW(A1:A31)/1000)/(MMULT((BITAND(ROW(A1:A31),{1,2,4,8,16})>0)*1,A1:A5)-D1<=0.1),1)*1000,1000)),5)
を入力してあります。

No.1
- 回答日時:
総当たりして、条件に合致するものを出すのがいいんじゃないか?
プログラムをどう作っていくかは、どういうところにポイントを置くかによって変わってくる。
・誰が読んでもわかりやすいものにしたいのか
・汎用性を高めたいのか
・処理速度を速めたいのか
・メモリなどのリソースを制限したいのか
・再帰などを試してみたいのか
・なるべくコードを短くしたいのか
・・・・・・
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- 数学 線形独立と線形従属 4 2021/11/02 08:13
- Visual Basic(VBA) Excelで同じ個所に複数同じ内容を反映させるには 6 2021/12/07 19:24
- Excel(エクセル) マクロで変数を用いてセルを選択し、そのセル内の数値を計算式に入れる方法 3 2021/12/27 22:59
- Excel(エクセル) ExcelのIF関数について 4 2023/05/24 12:54
- 統計学 プログラム、数学の計算について 1 2021/11/02 00:16
- Excel(エクセル) SUMIF関数について 4 2023/06/14 13:13
- Excel(エクセル) エクセルの関数について教えて下さい。 2 2021/12/15 15:47
- その他(Microsoft Office) エクセルの数式で教えてください。 3 2021/12/21 09:20
- その他(プログラミング・Web制作) Excel の判定式で正しく判定されない場合があります。 2 2022/05/31 14:43
- Excel(エクセル) xlDownの使い分けについての質問です vbaでxlDownを使って一覧近い空白までのセルをコピー 3 2022/08/04 12:20
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
音程とテンポを独立して変化さ...
-
小数点を含む数値かどうか判断...
-
Excel VBAにて、2GB超の点群デ...
-
あっち向いてホイのプログラム...
-
絶対パスの取得について
-
VB 電卓 メモリー機能
-
VBでの簡易電卓の作成(減算方...
-
符号付きにすべきか、符号なし...
-
C言語で、文字とか入力されなく...
-
SQLの速度をあげるには・・・
-
LINUX QT上でパソコンのシャッ...
-
win10で、正確な待ち時間の作り方
-
DoEvents関数って何?
-
Excel VBA での処理時間計測結...
-
テキスト処理の速度の速い言語
-
Macターミナルで実行中のプログ...
-
メッセージボックスのボタン名変更
-
フレームワーク「4.8.1」で、[S...
-
VBA kernel32 の意味
-
VBSの処理中一旦処理を止めて再...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
win10で、正確な待ち時間の作り方
-
Excelでのセル内容の高速消去方法
-
Excel VBAにて、2GB超の点群デ...
-
小数点を含む数値かどうか判断...
-
プログラム上のCPU稼働率低減に...
-
SQLの速度をあげるには・・・
-
DoEvents関数って何?
-
基本情報技術者試験詳しい方へ...
-
実行時のCPU使用率を増やしたい
-
VC++2010 GDIオブジェクトの解...
-
C言語 時刻差分の算出方法
-
ナップザック問題?をエクセル...
-
Excel(VBA)でSetTimer関数を使...
-
エクセルVBA 時間抜けの取得
-
VBでの簡易電卓の作成(減算方...
-
ノットイコールを教えて下さい
-
If Not c Is Nothing Then ~延...
-
Excel VBA データ削除の高速化
-
絶対パスの取得について
-
テキスト処理の速度の速い言語
おすすめ情報
ありがとうございます。
重視するのは処理速度だけで大丈夫です。
具体的なコードをご教示いただけますと幸いです。
また、完全合致することは少ないので、
なるべく許容量に近い組み合わせを優先で作っていくイメージになります。
よろしくお願い致します。