| |
今晩は。
難しかったですが、何とか出来ました。バグがあるかも知れないので、テストして
下さい。
【使い方】
ａ列の上から下に掛けて組み合わせる数字を書く。
b1に合計する数を書く。（この場合７４）。
下記コードを標準モジュールに書いて動かす。
【コード】
Option Explicit
Option Base 1
Dim sinki As Object
Dim ii() As Integer
Dim index As Integer, ic As Integer
Sub 合計()
ThisWorkbook.Worksheets(1).Copy
Set sinki = ActiveWorkbook
ReDim ii(Range("a65536").End(xlUp).Row)
ic = 3
index = 0
Range("A1").Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlGuess
Call 計算(1, Range("b1").Value)
End Sub
Private Sub 計算(ByVal i1 As Integer, ans2 As Integer)
Dim i As Integer
Cells(i1, 1).Select
If i1 > UBound(ii) Then
If ii(index) = UBound(ii) Then
index = index - 1
If index = 0 Then Exit Sub
End If
ii(index) = ii(index) + 1
ans2 = Range("b1").Value
For i = 1 To index
ans2 = ans2 - Cells(ii(i), 1)
Next
Call 計算(ii(index) + 1, ans2)
Else
ans2 = ans2 - Cells(i1, 1).Value
Select Case ans2
Case Is > 0
index = index + 1
ii(index) = i1
Call 計算(i1 + 1, ans2)
Case 0
ic = ic + 1
index = index + 1
ii(index) = i1
For i = 1 To index
Cells(i, ic).Value = Cells(ii(i), 1).Value
Next
ans2 = ans2 + Cells(i1, 1).Value
index = index - 1
Call 計算(i1 + 1, ans2)
Case Is < 0
ans2 = ans2 + Cells(i1, 1).Value
Call 計算(i1 + 1, ans2)
End Select
End If
End Sub
|
|
ナイスプログラム
- 06/9/13(水) 1:07 -
