Q&A
ご回答ありがとうございます。
結果がでませんでした。
私のやり方だと思います。済みません。
前提・実現したいこと
よろしくお願い致します。
＜質問＞
I2～I22にランダムに値（数字）が入力されています。
I J K L M N O P
2 1
3 3
4 5
5 9 3+6 4+5
6 12
・
・
・
22 35
例えば「I5」は9ですが、I2～I22までの値を足して「9」となる
組み合わせを「J22、K22、L22・・・」に表示させたいです。(I5列（3+6、4+5）のように)
かつ、表の上に希望の数字を入れるボックスと開始ボタンを付けたいです。
上記のようにすべての組み合わせを表示させたいのですが、
ソルバーではできず、自分なりにVBAを組んでみたのですが
初心者ということもあり、どの構文をどのようにして範囲をどこに
設定してよいかなどがわかりませんでした。
また、ボタンにVBAを登録はできるのですが、希望の数字を入力する
ボックスとそこに入力された数字をVBAに反映する方法も調べながら
やっては見たのですがうまく生きんせんでした。
丸投げのような形になってしまい、恐縮なのですがご存知の方が
いらっしゃいましたら、ご教授をお願い致します。
よろしくお願い致します。
試したこと
以前に見たことがある以下のものを使用してみたのですが、希望の結果は出ませんでした。
＊A1～A20に整数を入れ、B1～B20に足した結果を欲しい数字を入れて試しました
＜試したもの＞
Const MAX = 19
Dim idx(MAX) As Integer
Dim nums(1, MAX) As Integer
Sub test()
Dim y As Integer Dim r As Integer Dim total As Integer ' インデックスとデータを初期化 For y = 0 To MAX idx(y) = 0 nums(0, y) = Cells(y + 1, 1).Value nums(1, y) = 0 Next ' 全パターン組み合わせ出力 r = 1 Do ' 合計値を計算 total = 0 For y = 0 To MAX total = total + nums(idx(y), y) Next ' 合計値が一致した場合、結果を出力 If total = Cells(1, 2).Value Then Call OutResult(r) r = r + 1 End If ' 次の組み合わせ生成 If SetNext(MAX) Then Exit Do Loop
End Sub
Function SetNext(pos As Integer) As Boolean
SetNext = True If pos < 0 Then Exit Function idx(pos) = idx(pos) + 1 If idx(pos) > 1 Then idx(pos) = 0 If pos <> 0 Then SetNext = SetNext(pos - 1) Exit Function Else SetNext = True Exit Function End If End If SetNext = False
End Function
Sub OutResult(r As Integer)
Dim y As Integer Dim result As String result = "'" For y = 0 To 19 If idx(y) = 0 Then If result <> "'" Then result = result & "+" End If result = result & nums(0, y) End If Next Cells(r, 3).Value = result
End Sub
補足情報（FW/ツールのバージョンなど）
Windowa10
Excel2010
上記を使用しています。
どうぞよろしくお願いします。
回答3件
0
B列に要素をD5が合計を入力
ボタンは合計抽出にリンク
Sub 合計抽出()
Dim numbers() As Variant
Dim a$
Dim firstRow&, lastRow&, datanum&
firstRow = Cells(Cells(Rows.Count, "B").End(xlUp).Row, "B").End(xlUp).Row lastRow = Cells(Rows.Count, "B").End(xlUp).Row datanum = lastRow - firstRow '表示領域初期化 a$ = "F" + Format(firstRow + 1) Range(a$).CurrentRegion.Clear 'アイテム a$ = "F" + Format(firstRow) Range(a$) = "④組合せ結果" a$ = "H" + Format(firstRow) Range(a$) = "組合せ個数" a$ = "J" + Format(firstRow) Range(a$) = "タイプ数" a$ = "L" + Format(firstRow) Range(a$) = "組合せ合計" '要素データ a$ = "B" + Format(firstRow + 1) + ":" + "B" + Format(lastRow) numbers = Range(a$).Value '合計 Dim targetSum As Long a$ = "D" + Format(firstRow + 1) targetSum = Range(a$) FindSum numbers, targetSum, datanum
End Sub
Sub FindSum(numbers() As Variant, targetSum As Long, ndata&)
Dim stack() As Variant
Dim firstRow&
Dim a$, b$, s$()
ReDim stack(1 To ndata) ' 適宜サイズを調整
Dim stackPointer As Long
stackPointer = 0
Dim currentSum As Long currentSum = 0 Dim currentCombination() As Variant ReDim currentCombination(1 To ndata) ' 適宜サイズを調整 Dim currentCombinationPointer As Long currentCombinationPointer = 0 Dim currentIndex As Long currentIndex = 1 Dim foundCombination As Boolean foundCombination = False firstRow = Cells(Cells(Rows.Count, "B").End(xlUp).Row, "B").End(xlUp).Row Dim k As Long b$ = "" Dim Skip% k = 1 Dim imax&, kmax& imax = -9999 kmax = -9999 Do If currentSum = targetSum Then ' 合計値に到達した場合、組み合わせを表示する Dim i As Long Dim total& a$ = "" For i = 1 To currentCombinationPointer a$ = Format(currentCombination(i)) + "," + a$ Next i Skip = 0 s = Split(b$, "@") For i = 0 To UBound(s) If s(i) <> a$ Then Skip = 1 Exit For Next b$ = a$ + "@" + b$ If k = 1 Or Skip = 1 Then '重複していない total = 0 k = k + 1 a$ = "" For i = 1 To currentCombinationPointer 'Rows(firstRow + k - 1).Interior.Color = xlNone Cells(firstRow + k - 1, i + 5) = currentCombination(i) '組合せ要素 Cells(firstRow + k - 1, i + 5).Interior.ColorIndex = 8 total = total + currentCombination(i) Next i If imax < i Then imax = i Cells(firstRow, "I") = i - 1 '組合せ要素数 Cells(firstRow, "M") = total '合計値 End If 'Exit Do foundCombination = True End If If currentIndex <= UBound(numbers) Then If currentSum + numbers(currentIndex, 1) <= targetSum Then ' 数字を選択する場合 currentCombinationPointer = currentCombinationPointer + 1 currentCombination(currentCombinationPointer) = numbers(currentIndex, 1) stackPointer = stackPointer + 1 stack(stackPointer) = currentIndex currentSum = currentSum + numbers(currentIndex, 1) currentIndex = currentIndex + 1 Else currentIndex = currentIndex + 1 End If Else ' 数字を選択しない場合、または合計値に到達した場合 If stackPointer > 0 Then ' スタックから前の状態に戻る currentIndex = stack(stackPointer) stackPointer = stackPointer - 1 currentSum = currentSum - currentCombination(currentCombinationPointer) currentCombination(currentCombinationPointer) = 0 currentCombinationPointer = currentCombinationPointer - 1 currentIndex = currentIndex + 1 Else Cells(firstRow, "K") = k - 1 '組合せタイプ数 MsgBox "全ての組み合わせを探索ました" '場合、ループを終了する Exit Do End If End If Loop If Not foundCombination Then MsgBox "組み合わせが見つかりませんでした。" End If
End Sub
投稿2023/06/20 02:12
総合スコア2
0
I列がランダム出現したいなら、ワークシート関数のRANDOMBETWEEN関数が有効です。
VBA
1Sub sample2() 2 Dim n As Integer 3 Dim i As Integer 4 Dim x As Integer 5 x = 0 6 Range("I1").Select 7 Do Until ActiveCell.Offset(x, 0).Value = "" 8 n = ActiveCell.Offset(x, 0).Value 9 For i = 1 To n - 1 10 ActiveCell.Offset(x, i).Value = i & "+" & n - i 11 Next i 12 x = x + 1 13 Loop 14End Sub
投稿2020/07/29 12:01
総合スコア344
0
足し算の組み合わせですよね。
希望の数値を入力したいとなると、組み合わせは、必然的に１種類だけだと思います。
だったら、こんな感じでしょうかね？
VBA
1Sub sample1() 2 3 Dim n As Integer 4 Dim i As Integer 5 Dim j As Integer 6 7 If ActiveCell.Value = "" Then Exit Sub 8 If Not IsNumeric(ActiveCell.Value) Then Exit Sub 9 If Not (ActiveCell.Value Mod 1) = 0 Then Exit Sub 10 11 n = ActiveCell.Value 12 j = InputBox("和の結果は、「 " & n & " 」です。" & vbCrLf & "希望の数値を入力して下さい。", "希望の数値入力", 1) 13 14 For i = 1 To n - 1 15 If j = i Then 16 ActiveCell.Offset(0, 1).Value = i & "+" & n - i 17 Exit Sub 18 End If 19 Next i 20 21End Sub
投稿2020/07/25 02:41
総合スコア344
ご回答いただきありがとうございます。
「組み合わせは、必然的に１種類だけだと思います」とありますが
例えば、５にするには「1+4」、「2+3」など数種類ありますので、「1種類だけ」には
なりませんし、"すべての組み合わせ" の回答を出力させたいのです。
だとすると、(n-1)種類の回答が存在しますね。
forステートメントを使用してできますね。
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。