Option Explicit
Sub test()
Dim ar, i&, j&, dr(), er(), vResult(), t#, r&, iCount&
t = Timer
With [B1:AH2]
ar = Application.Index(.Value, 2)
dr = Application.Index(.Value, 1)
End With
ReDim er(1 To 6)
ReDim vResult(1 To WorksheetFunction.Combin(UBound(dr), 6), 1 To 6)
combinArr dr, er, vResult, 6, r
r = 0
For i = 1 To UBound(vResult)
iCount = 0
For j = 1 To UBound(vResult, 2)
iCount = iCount + ar(vResult(i, j))
Next j
If iCount = 33 Then
r = r + 1
For j = 1 To UBound(vResult, 2)
vResult(r, j) = vResult(i, j)
Next j
End If
Next i
If r Then [AY3].Resize(r, UBound(vResult, 2)) = vResult
Beep
End Sub
Function combinArr(ByRef ar(), ByRef br(), ByRef cr(), ByVal n&, Optional ByRef iGroup&, Optional ByVal iStart&, Optional ByVal iNum& = 1)
Dim i&, j&
For i = iStart + 1 To UBound(ar) - n + iNum
If iNum < n Then
br(iNum) = ar(i)
Call combinArr(ar, br, cr, n, iGroup, i, iNum + 1)
Else
br(iNum) = ar(i)
iGroup = iGroup + 1
For j = 1 To n
cr(iGroup, j) = br(j)
Next
End If
Next
End Function
|