questa e' la macro che utilizzo gia' per i 24 numeri.
Ho cercato di adattarla a 45 numeri, rispettando le indicazioni che hai specificato.
Questo e' il punto dove mi segnala errore :
- Codice: Seleziona tutto
Range("I7:P7").Resize(col2h, 8).FillDown
Puoi controllare ed eliminare l' errore ?
Grazie.
Nelson
- Codice: Seleziona tutto
Public col(100), r, n, nr As Long, Col2() As Variant
Function comb2(k)
'by Anthony47; Variante che lavora con Col2()
col(k) = col(k - 1)
While col(k) < n - r + k
col(k) = col(k) + 1
If k < r Then
comb2 (k + 1)
Else
nr = nr + 1
For I = 1 To r
Col2(nr - 1, I - 1) = col(I)
'Cells(nr, i) = col(i)
Next
End If
Wend
End Function
Sub CombAnth()
'by Anthony47
Dim combArr(), I As Long, J As Long, curCalc
Dim myCombList As String, myMembri As String, myGroup As String, myDest As String
'
'Se M1 e' vuoto si combinano numeri interi da 1 a N
myCombList = "M2" '<<< La cella dove comincia l' elenco delle voci da Combinare
myMembri = "C3" '<<< La cella che contiene il numero di valori da combinare
myGroup = "C4" '<<< La cella che contiene il numero di elementi per ogni gruppo
myDest = "J6" '<<< La cella da dove sara' creato l' elenco combinatorio
'
curCalc = Application.Calculation
Application.Calculation = xlManual
'
If Range(myCombList) <> "" Then
ReDim combArr(1 To 101)
For I = 0 To 100
If Range(myCombList).Offset(0, I) <> "" Then
combArr(I + 1) = Range(myCombList).Offset(0, I).Value
Else
ReDim Preserve combArr(1 To I)
Exit For
End If
Next I
End If
col2h = Evaluate("FACT(" & myMembri & ")/FACT(" & myGroup & ")/FACT(" & myMembri & "-" & myGroup & ")")
ReDim Col2(col2h, Range(myGroup) - 0)
'Ih = 1: Iv = 1
Range(myDest).Resize(Rows.Count - Range(myDest).Row - 1, 5).ClearContents '<<<*** Vedi testo
Range("I8:P8").Resize(Rows.Count - 9, 8).ClearContents
nr = 0
k = 1
r = Range(myGroup)
n = Range(myMembri)
'[g1] = Timer
comb2 (k)
'
If UBound(combArr, 1) < 100 Then
For I = LBound(Col2, 1) To UBound(Col2, 1)
For J = LBound(Col2, 2) To UBound(Col2, 2)
If Not IsEmpty(Col2(I, J)) Then Col2(I, J) = combArr(Col2(I, J))
Next J
Next I
End If
Range("I7:P7").Resize(col2h, 8).FillDown
Range(myDest).Resize(col2h, Range(myGroup)) = Col2
'[g2] = Timer
ReDim Col2(1, 1)
Application.Calculation = curCalc
Calculate
End Sub
; e un po' mi spiace che non hai vinto nemmeno tu 