excel macro lotto

[gikeleva]

Buongiorno a tutti,
in passato era stata sviluppata da Flash e da Anthony, che ancora ringrazio, una macro che:

Presuppone che ci sia un elenco in Col A:E e un secondo elenco in L:P; viene creato un terzo elenco in R:V che contiene i record del primo elenco escluso quelli che si trovano anche nel secondo elenco. (viewtopic.php?f=26&t=96145).

Ora vi chiedo è possibile condizionare il terzo elenco R:V che contenga i record del primo elenco A:E con un massimo di 0123 presenze del secondo elenco L:P
Esempio:
A-B-C-D-E------------------L-M-N-O-P-------------------------R-S-T-U-V-
1-2-3-4-5-------------------1-2-3-4-7--------------------------1-2-3-5-6
1-2-3-5-6-------------------1-2-3-4-8
1-2-3-6-7-------------------1-2-3-4-10
(1-2-3-4-7 riporta 4 presenze in 1-2-3-4-5 e 1-2-3-6-7 e quindi in R:V viene riportato solo 1-2-3-5-6).

Spero di essere stato chiaro e un grazie naturalmente per l'aiuto.
Gio

[Anthony47]

Hummm...
All' inizio ero solo confuso, ma dopo "Esempio: [. . .] (1-2-3-4-7 riporta 4 presenze in 1-2-3-4-5 e 1-2-3-6-7 e quindi in R:V viene riportato solo 1-2-3-5-6)" mi si e' spenta del tutto la luce...
Insomma non ho afferrato bene la richiesta.

Inoltre potrebbe essere utile un file di test, anche solo con 10-20mila righe.

Ciao

[gikeleva]

Cerco di essere più chiaro, nell'esempio:

A-B-C-D-E------------------L-M-N-O-P-------------------------R-S-T-U-V-
1-2-3-4-5-------------------1-2-3-4-7--------------------------1-2-3-5-6
1-2-3-5-6-------------------1-2-3-4-8
1-2-3-6-7-------------------1-2-3-4-10

1-2-3-4-5 non soddisfa la condizione di contenere un massimo di 3 presenze in L:P, infatti contiene 4 presenze in 1-2-3-4-7 e quindi viene scartata e non riportata in R:V (basta che si verifichi anche una sola volta per essere scartata, mentre nell'esempio contiene 4 presenze anche in 1-2-3-4-8 e 1-2-3-4-10).

1-2-3-5-6 viene riportata in R:V perché contiene un massimo di 3 presenze in L:P e quindi soddisfa la condizione (verrebbe riportata anche se ne contenesse 0 oppure 1 oppure 2 oppure 3 come nell'esempio)

1-2-3-6-7 non soddisfa la condizione in quanto contiene 4 presenze in 1-2-3-4-7.

Di fatto ogni singola combinazione di A:E viene confrontata con le singole combinazione di L:P e per essere riportata in R:V deve contenere o 0 oppure 1 oppure 2 oppure 3 delle singole combinazioni in L:P.

Grazie Anthony,
spero di essere stato più chiaro.
Gio

[Anthony47]

In questo modo l' algoritmo che controllava la presenza dell' intero blocco nella seconda lista non puo' essere piu' sfruttato, dovendo contare i singoli elementi del blocco con ogni singolo elemento della seconda lista.
Della precedente macro si recupera qualcosa, ma poco; la nuova macro:

Codice: Seleziona tutto

Sub Sett013_1()
'Riporta in R:V le righe dell' elenco in A:E che non hanno in nessuna delle righe in L:P
'   piu' di 3 elementi presenti
'
Dim myVArrA As Variant, myVArrB As Variant, myArrC(), myLinArr As Variant, L As Long, p As Long
Dim LastA As Long, LastB As Long, I As Long, J As Long, K As Long, MtchCount As Long

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Range("R:V").Clear
'
LastA = Cells(Rows.Count, 12).End(xlUp).Row
LastB = Cells(Rows.Count, 1).End(xlUp).Row

'LastA = 1000: LastB = 2000        '<<** Uso test

ReDim myArrC(1 To LastB)
[G1] = Timer
myVArrA = Range("L1:P" & LastA).Value
myVArrB = Range("A1:E" & LastB).Value

For I = LBound(myVArrB, 1) To UBound(myVArrB, 1)
    For J = LBound(myVArrA, 1) To UBound(myVArrA, 1)
        MtchCount = 0
        For K = LBound(myVArrB, 2) To UBound(myVArrB, 2)
            For L = LBound(myVArrA, 2) To UBound(myVArrA, 2)
                If myVArrB(I, K) = myVArrA(J, L) Then MtchCount = MtchCount + 1
            Next L
        Next K
        If MtchCount > 3 Then GoTo SkipJ
    Next J
    p = p + 1
    myArrC(p) = myVArrB(I, 1) & "-" & myVArrB(I, 2) & "-" & myVArrB(I, 3) & "-" & myVArrB(I, 4) & "-" & myVArrB(I, 5)

SkipJ:
Next I

'Carica risultato in col P
ReDim Preserve myArrC(1 To p)
If J < 65536 Then
    Range("R1:R" & UBound(myArrC, 1)) = Application.WorksheetFunction.Transpose(myArrC())
Else
    For I = 1 To J
        Cells(I, "R") = myArrC(I)
    Next I
End If

'Testo in colonna
Columns("R:R").Select
    Selection.TextToColumns Destination:=Range("R1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1)), TrailingMinusNumbers:=True
    Range("L1").Select


[G3] = Timer

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub


Ti avviso che i tempi sono disastrosi; puoi fare delle prove abilitando l' istruzione marcata <<** e impostando la lunghezza dei due elenchi su valori piccoli, prima di decidere (in funzione dei tempi di esecuzione sperimentati) di sfidare gli elenchi completi. A me l' elaborazione di elenchi da 1000*2000 mangia 10 sec.

Ciao

[gikeleva]

Ciao Anthony,
grazie per la risposta.

Ho provato ad eseguire la macro ma mi da "errore di run-time 9 Indice non incluso nell'intervallo"

ReDim Preserve myArrC(1 To p)

Ho provato a fare qualche modifica, ma come hai potuto ben capire non sono molto esperto in macro.
Ciao e grazie ancora per il lavoro....
Gio

[gikeleva]

Rettifico,
la macro funziona perfettamente se riesce a trovare almeno una combinazione che soddisfa la condizione, altrimenti da l'errore che dicevo prima.
E' possibile in questo caso evitare che la macro dia errore o far riportare "Nessuna combinazione presente" o altro?
Grazie ancora,
ciao Gio

[Anthony47]

Hum... su una situazione reale o di prova??
Hai copiato la macro dal mio messaggio precedente e l' hai incollata nell' editor delle macro, vero? (cioe' non l' hai riscritta)

Comunque quando va in errore, scegli Dubug; poi
-premi Contr-g, ti si aprira' la "finestra Immediata"
-nella finestra inferiore inserisci:
?p
?ubound(myarrc,1)
?ubound(myarrc,2)
(queste le devi scrivere da tastiera, non copiare e poi incollare)
Ad ogni stringa ti restituira' un valore oppure... Scrivimi nel prossimo messaggio la risposta data a queste 3 interrogazioni.

Ciao

[gikeleva]

Ciao Anthony,
ho copiato la macro che hai scritto, non riscritta; le risposte ottenute sono:

?p 0
?ubound(myarrc,1) Errore di run-time 13 Tipo non corrispondente
?ubound(myarrc,2) Errore di run-time 13 Tipo non corrispondente

Per quanto riguarda i tempi in effetti sembrano piu che disastrosi, pensi che non sia possibile ridurli notevolmente?

Sempre un grazie per il lavoro,
ciao Gio

[Anthony47]

In realta' il mio post precedente non l' avrei scritto se avessi letto bene la discussione (in particolare: "Rettifico, la macro funziona perfettamente se riesce a trovare almeno una combinazione che soddisfa la condizione").
Per gestire questa situazione si aggiungera' nella macro l'istruzione marcata <<<<AGGIUNGERE:

Codice: Seleziona tutto

Next I

If p=0 then Range("R1").Value = "Nessuna combinazione" : Exit Sub       '<<<<AGGIUNGERE

'Carica risultato in col P
ReDim Preserve myArrC(1 To p)


Quanto ai tempi, dovendo necessariamente leggere le singole celle e confrontarle con quelle del secondo elenco non vedo immediate semplificazioni, ma qualcosa si puo' provare (avendo tempo). Una ulteriore semplificazione si potrebbe fare se i dati fossero, in ogni riga, in ordine crescente.

Ciao

[gikeleva]

Problema precedente risolto, ma se carico circa 700000 combinazioni in A:E e anche una sola combinazione in L:P mi da:

Errore di run-time 13 Tipo non corrispondente
Debug
Range("R1:R" & UBound(myArrC, 1)) = Application.WorksheetFunction.Transpose(myArrC())

Ciao Gio

P.S.: I dati delle singole righe sono sempre in ordine crescente (la velocità in effetti è un grosso handicap).