Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Combinare N simboli a gruppi di K

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Combinare N simboli a gruppi di K

Postdi nelson1331 » 21/04/21 05:56

Ciao Anthony47,
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
nelson1331
Utente Junior
 
Post: 58
Iscritto il: 18/02/08 08:58

Sponsor
 

Re: Macro che segnala errore con piu' di 24 numeri.

Postdi Anthony47 » 21/04/21 12:02

Sono certo che il codice e' mio, ma senza nessuna informazione su come lo stai utilizzando penso che solo mago merlino potrebbe dire qualcosa...
Dalla posizione dell'errore direi che stai cercando di generare piu' righe di quante Excel sia in grado di contenerne.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 17656
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Macro che segnala errore con piu' di 24 numeri.

Postdi nelson1331 » 22/04/21 07:23

Anthony47 si' il problema e' quello che hai individuato.
Una volta che ha completato il max. delle colonne excel, puoi dirgli di ricominciare dalla medesima riga, lasciando lo spazio vuoto di almeno 2 colonne ?
Ora li scrive iniziando alla riga 6 sulle colonne J,K,L,M,N e se fosse possibile vorrei che i restanti iniziasse a scriverli dalle colonne Q,R,S,T,U.
Grazie se puoi fare questa modifica.
Nelson
nelson1331
Utente Junior
 
Post: 58
Iscritto il: 18/02/08 08:58

Re: Combinare N simboli a gruppi di K

Postdi Anthony47 » 22/04/21 15:18

Allora...
Il codice di cui parliamo serve a creare le combinazioni di N simboli a gruppi di M (es combinare 45 numeri a gruppi di 5)
La numerosita' dei simboli da combinare va indicata in C3 (es 45)
La dimensione (classe) dei gruppi da creare va indicata in C4 (es 5)
I simboli da combinare vanno riportati da M2 verso destra; devono essere presenti almeno tanti simboli quanti indicati in C3
Tutte le posizioni suddette sono impostabili nella Sub CombAnth (vedi istruzioni marcate <<<)

Il codice gia' pubblicato gestisce fino a 1.048.570 raggruppamenti, poi va in overflow di righe.
Il nuovo codice che pubblico supera questo limite; ora i raggruppamenti verranno creati da J6 in avanti; se sono stati creati piu' di 1milione di raggruppamenti essi verranno scritti a gruppi di 1milione, continuando poi sulle colonne adiacenti e lasciando 2 colonne di vuoto.

Si tenga presente che la combinazione di 45 simboli in classe 5 genera 1221759 sottoinsiemi; 45 elementi in classe 6 ne generera' 8145060; in classe 7 ne risulteranno 45379620, e cosi' a crescere.
Non mi sono preoccupato di calcolare quando le capacita' di excel saranno esaurite, do' per scontato che le vostre esigenze siano ampiamente inferiori a questo limite.

Il nuovo codice complessivo:
Codice: Seleziona tutto
Public col(100), r, n, nr As Long, Col2() As Variant

Function comb2(k)
'Ver_C10422
'by Anthony47; Variante che lavora con Col2() e supera il limite di 1milione di righe
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 myCombList 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)
'
Dim oAUb As Long, oArr(), oAInd As Long, Blk As Long
'
If UBound(Col2) > 1000000 Then oAUb = 1000000 Else oAUb = UBound(Col2)
ReDim oArr(LBound(Col2) To oAUb, LBound(Col2, 2) To UBound(Col2, 2))
oAInd = LBound(Col2)
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
                oArr(oAInd, J) = combArr(Col2(I, J))
            End If
        Next J
        oAInd = oAInd + 1
        If oAInd > 1000000 Then
            Range(myDest).Offset(0, Blk * (Range(myGroup) + 2)).Resize(1000010, Range(myGroup) + 4).ClearContents
            Range(myDest).Offset(0, Blk * (Range(myGroup) + 2)).Resize(oAInd, Range(myGroup)) = oArr
            oAInd = LBound(Col2)
            Blk = Blk + 1
            DoEvents
            Beep
        End If
    Next I
End If
'Range("I7:P7").Resize(col2h, 8).FillDown
Range(myDest).Offset(0, Blk * (Range(myGroup) + 2)).Resize(1000010, 6 + Range(myGroup)).ClearContents
Range(myDest).Offset(0, Blk * (Range(myGroup) + 2)).Resize(oAInd - 1, Range(myGroup)) = oArr
'Range(myDest).Resize(col2h, Range(myGroup)) = Col2
'[g2] = Timer
ReDim Col2(1, 1)
Application.Calculation = curCalc
Calculate
End Sub

Il codice va inserito in un modulo standard del vba inizialmente vuoto.
Le modifiche apportate riguardano solo la Sub CombAnth

Buon lavoro...
Avatar utente
Anthony47
Moderatore
 
Post: 17656
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Combinare N simboli a gruppi di K

Postdi nelson1331 » 23/04/21 08:44

Ancora una volta, grazie Anthony47.
Lavoro perfetto.
Ti avevo inviato un MP relativo alle previsioni su Venezia, per ieri sera : fra i 2 capigioco segnalati vi erano il 42.90 e fra gli abbinamenti, il 45.
La cinquina vincente ieri sera a Venezia, e' stata : 23.86.54.45.90
Centrare 1 capogioco al 1° colpo e su ruota specifica, non e' una cosa semplice.
Controlla se quanto ho scritto ora corrisponde al MP che ti avevo inviato ieri e se puoi rispondimi in merito ad una richiesta ivi specificata.
Grazie.
Nelson
nelson1331
Utente Junior
 
Post: 58
Iscritto il: 18/02/08 08:58

Re: Combinare N simboli a gruppi di K

Postdi Anthony47 » 23/04/21 19:05

Ok, ho capito che ieri non e' uscita la mia cinquina preferita, 1-2-3-4-5 :D ; e un po' mi spiace che non hai vinto nemmeno tu :lol:

Controlla se quanto ho scritto ora corrisponde al MP che ti avevo inviato ieri e se puoi rispondimi in merito ad una richiesta ivi specificata.
Io pero' non ho nessun MP... Sara' rimasto in bozza sul tuo PC?
Comunque metto le mani avanti: non sono in grado di aiutare per problemi che non possano essere pubblicati sul forum e che quindi non possano avere una utilita' teoricamente comune.

Ciao!
Avatar utente
Anthony47
Moderatore
 
Post: 17656
Iscritto il: 21/03/06 16:03
Località: Ivrea


Torna a Applicazioni Office Windows


Topic correlati a "Combinare N simboli a gruppi di K":


Chi c’è in linea

Visitano il forum: Nessuno e 56 ospiti