Hello,
I have the below next Sixth Sense's code, that I found in:
http://www.mrexcel.com/board2/viewtopic.php?t=80690
The code displays the results:
I have the below next Sixth Sense's code, that I found in:
http://www.mrexcel.com/board2/viewtopic.php?t=80690
The code displays the results:
cformat.xls | ||||||||
---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | |||
1 | list | Desired sum | possible combination | Sum | ||||
2 | 1 | 10 | 4+6= | 10 | ||||
3 | 2 | 2+3+5= | 10 | |||||
4 | 3 | 1+4+5= | 10 | |||||
5 | 4 | 1+3+6= | 10 | |||||
6 | 5 | 1+2+3+4= | 10 | |||||
7 | 6 | |||||||
8 | ||||||||
9 | ||||||||
10 | ||||||||
11 | ||||||||
12 | ||||||||
13 | ||||||||
14 | ||||||||
15 | ||||||||
Sheet1 |
Code:
Option Explicit
Dim n, k, q As Double
Dim Comblist() As String
Dim b()
Dim Ans() As Variant
Private Sub Comb(j, m As Integer)
Dim tmp, X
If j > n Then
tmp = ""
For X = 1 To n
tmp = tmp & b(X)
Next X
q = q + 1
ReDim Preserve Comblist(UBound(Comblist) + 1) As String
Comblist(UBound(Comblist)) = tmp
Else
If k - m< n - j + 1 Then
b(j) = 0
Comb j + 1, m
End If
If m< k Then
b(j) = 1
Comb j + 1, m + 1
End If
End If
End Sub
Sub Sumxxx()
Dim St, i, j, tmp, Tmp2, AnsCount, L, Res
Dim listx()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
n = Range("a65536").End(xlUp).Row - 1
Res = Range("b2").Value
q = 0
ReDim Comblist(0) As String
ReDim b(n)
ReDim listx(n)
ReDim Ans(0)
For k = 1 To n
Comb 1, 0
Next k
For i = 1 To n
listx(i) = Range("a" & 1 + i).Value
Next i
AnsCount = 0
For i = LBound(Comblist) To UBound(Comblist)
St = ""
tmp = 0
For j = 1 To Len(Comblist(i))
tmp = tmp + Mid(Comblist(i), j, 1) * listx(j)
If Mid(Comblist(i), j, 1) = 1 Then
St = St & "+" & listx(j)
End If
Next j
If tmp = Res Then 'Or (tmp >= 0.9 * Res And tmp<= 1.1 * Res) Then
ReDim Preserve Ans(UBound(Ans) + 1)
AnsCount = AnsCount + 1
Ans(AnsCount) = St
End If
Next i
Range("e2:f65536").Value = ""
For i = LBound(Ans) + 1 To UBound(Ans)
Range("e" & i + 1).Value = "'" & Mid(Ans(i), 2, Len(Ans(i))) & "="
Range("F" & i + 1).Value = "=" & Ans(i)
Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub