excel macro lotto

[gikeleva]

Buongiorno a tutti,
è possibile con una macro confrontare velocemente circa 500.000 combinazioni A:E (prima serie Base) con altrentante combinazioni, o meno o più, scritte sullo stesso foglio L:P (o altro foglio) cancellando sulla Base A:E le combinazioni in comune?
Spero di essere stato chiaro e ringrazio anticipatamente coloro che vorranna aiutarmi.
Gio

[Flash30005]

Ciao Gikeleva e benvenuto nel Forum

Per essere fattibile, dovrebbe esserlo
per eseguire "velocemente" è un fattore soggettivo, dovuto alla pazienza
e oggettivo, dovuto al software (sviluppo della macro) e dall'HardWare in possesso

Prova a postare il file con degli esempi di cosa vorresti ottenere e vediamo di risolvere.

ciao

[gikeleva]

Ciao, grazie per la veloce risposta.
Uso Excel 2010 e cerco di essere più chiaro.
A. B. C. D. E. L. M. N. O. P.
1. 2. 3. 4. 5. 1. 3. 4. 5. 6.
1. 3. 4. 5. 6. 1. 3. 4. 5. 8.
e così via
Vorrei in questo caso cancellare la riga A2:E2 perché uguale a L1:P1
e così via per tutte le combinazioni.
Qualsiasi soluzione per velocizzare è auspicabile.
Ciao e grazie ancora per l'aiuto.
Gio
Ciao e grazie ancora per l'aiuto

[Flash30005]

Non so quanto tempo impieghi per 500.000 colonne ma... è sufficiente provare

Codice: Seleziona tutto

Sub CancellaVal()
Application.ScreenUpdating = False
Application.Calculation = xlManual
UR = Range("A" & Rows.Count).End(xlUp).Row
For RR = 1 To UR - 1
For RR2 = RR + 1 To UR
    If Evaluate("=SUM(COUNTIF(Foglio1!A" & RR & ":E" & RR & ",Foglio1!A" & RR2 & ":E" & RR2 & "))") = 5 Then Range("A" & RR2 & ":E" & RR2).ClearContents
    If Evaluate("=SUM(COUNTIF(Foglio1!A" & RR & ":E" & RR & ",Foglio1!L" & RR2 & ":P" & RR2 & "))") = 5 Then Range("L" & RR2 & ":P" & RR2).ClearContents
    If Evaluate("=SUM(COUNTIF(Foglio1!L" & RR & ":P" & RR & ",Foglio1!A" & RR2 & ":E" & RR2 & "))") = 5 Then Range("A" & RR2 & ":E" & RR2).ClearContents
    If Evaluate("=SUM(COUNTIF(Foglio1!L" & RR & ":P" & RR & ",Foglio1!L" & RR2 & ":P" & RR2 & "))") = 5 Then Range("L" & RR2 & ":P" & RR2).ClearContents
Next RR2
Next RR
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


ciao

[gikeleva]

Al momento sono in spiaggia..... e non mi è possibile provare la velocità, ma ho provato la tua di velocità.
Al momento ti ringrazio tantissimo e ti faró sapere.
Ciao Gio

[Flash30005]

Ho fatto un test con 500.000 colonne e ho appurato che i tempi sono lunghissimi
pertanto ho apportato una miglioria valida soprattutto se ci sono gruppi di righe uguali
Inoltre in T1, a fine processo, avrai il tempo impiegato in secondi

Codice: Seleziona tutto

Sub CancellaVal()
[R1] = Int(Timer)
Application.ScreenUpdating = False
Application.Calculation = xlManual
UR = Range("A" & Rows.Count).End(xlUp).Row
For RR = 1 To UR - 1
If Range("A" & RR).Value = "" And Range("L" & RR).Value = "" Then GoTo SaltaRR
For RR2 = RR + 1 To UR
If Range("A" & RR2).Value = "" And Range("L" & RR2).Value = "" Then GoTo SaltaRR2
    If Evaluate("=SUM(COUNTIF(Foglio1!A" & RR & ":E" & RR & ",Foglio1!A" & RR2 & ":E" & RR2 & "))") = 5 Then Range("A" & RR2 & ":E" & RR2).ClearContents
    If Evaluate("=SUM(COUNTIF(Foglio1!A" & RR & ":E" & RR & ",Foglio1!L" & RR2 & ":P" & RR2 & "))") = 5 Then Range("L" & RR2 & ":P" & RR2).ClearContents
    If Evaluate("=SUM(COUNTIF(Foglio1!L" & RR & ":P" & RR & ",Foglio1!A" & RR2 & ":E" & RR2 & "))") = 5 Then Range("A" & RR2 & ":E" & RR2).ClearContents
    If Evaluate("=SUM(COUNTIF(Foglio1!L" & RR & ":P" & RR & ",Foglio1!L" & RR2 & ":P" & RR2 & "))") = 5 Then Range("L" & RR2 & ":P" & RR2).ClearContents
SaltaRR2:
Next RR2
SaltaRR:
Next RR
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
[S1] = Int(Timer)
[T1] = [S1] - [R1]
End Sub

Tempo impiegato circa 10' - Il test è stato eseguito, però, con 5 righe copiate 100.000 volte pertanto con altre combinazioni di numeri i tempi saranno notevolmente superiori al test.

Ciao

[gikeleva]

Ti ringrazio per la prova, in effetti i tempi sono molto lunghi.
Una soluzione alternativa quale potrebbe essere? Invece di cancellare le righe uguali, colorarle ? o individuarle con CONTA.SE ed eliminarle manualmente (scusa per le domande forse banali, ma come avrai capito con macro e c. non sono molto efferato).
Ciao e buona domenica.
Gio

[Anthony47]

Una macro come questa potrebbe ridurre significativamente i tempi di elaborazione:

Codice: Seleziona tutto

Sub BxorAColl()
'wip con uso di Collection
'
Dim AColl As New Collection
'
Dim myArrC(), myVArrA, myVArrB, LastA As Long, LastB 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
ReDim myArrC(1 To LastB)
[G1] = Timer
myVArrA = Range("L1:P" & LastA).Value
myVArrB = Range("A1:E" & LastB).Value
'Col A -> Collection:
For I = LBound(myVArrA, 1) To LastA
On Error Resume Next
myItem = myVArrA(I, 1) & "-" & myVArrA(I, 2) & "-" & myVArrA(I, 3) & "-" & _
        myVArrA(I, 4) & "-" & myVArrA(I, 5)
'If Application.WorksheetFunction.IsText(myVArrA(I, 1)) Then
    AColl.Add myItem, myItem
'End If
Next I
On Error GoTo 0
[G2] = Timer
'Confronta col B con la Collection:
For I = 1 To LastB
'If Application.WorksheetFunction.IsText(myVArrB(I, 1)) Then
    Err.Clear
    On Error Resume Next
        yrItem = myVArrB(I, 1) & "-" & myVArrB(I, 2) & "-" & myVArrB(I, 3) & _
                "-" & myVArrB(I, 4) & "-" & myVArrB(I, 5)
        scrvar = AColl.Item(yrItem)
        errNum = CLng(Err.Number)
    On Error GoTo 0
    If errNum = 5 Then 'missing...
        J = J + 1
        myArrC(J) = yrItem
    Else
        cvcv = 1   'solo per debug
    End If
   
'End If
Next I
'
'Carica risultato in col C
ReDim Preserve myArrC(1 To J)
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


E' derivata da quanto sviluppato per rosseaux qui: viewtopic.php?f=26&t=96141&start=20#p551604

Al momento usa le celle G1-G2-G3 per calcolare i tempi di esecuzione; se queste celle non sono libere eliminare le righe relative.

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.
Testata su elenco casuale di 400K + 400K record sta' sui 35 secondi.

Spero si di qualche utilita'

Ciao

[gikeleva]

Grazie Anthony,
in effetti i tempi si sono notevolmente ridotti confrontando circa 590.000 con 273.000 combinazioni ha impiegato un minuto circa,
fantastico.
Ciao e ancora un grazie.
Gio

[Flash30005]

Ne ero certo!
Tempi ridottissimi

L'unica cosa è che non fa quanto richiesto (o ho interpretato male io il quesito)

Ho capito che in caso di 5 numeri es.: da A1:E1 uguali a L5:P5 le celle L5:P5 venivano cancellate
oppure A2:E2 = A15:E15 viene cancellato il secondo range (stessa cosa in L:P)
quindi vengono eliminati tutti i duplicati e dovrebbero rimanere solo righe (composte da 5 celle) univoche
Ok per il nuovo elenco in R:V ma nel mio test lì mi trovo righe quasi tutte uguali
Es: A1:E5
1 2 3 4 5
1 2 3 4 5
1 4 5 6 7
1 5 6 7 8
1 3 4 5 6
L1:P5
1 3 4 5 6
1 3 4 5 8
1 3 4 5 10
1 2 3 4 5
1 3 4 5 6

in R:V mi trovo righe così ripetute
1 4 5 6 7
1 5 6 7 8
1 4 5 6 7
1 5 6 7 8
1 4 5 6 7
1 5 6 7 8
1 4 5 6 7
1 5 6 7 8
1 4 5 6 7
1 5 6 7 8

e manca la riga
1 3 4 5 10

Sbaglio qualcosa?

ciao

[gikeleva]

Forse mi ero espresso male io, ma in effetti fa quanto richiesto.
Es. nelle combinazioni A1:E500.000 devono essere cancellate i doppioni presenti nelle combinazioni L1:P500.000 e quindi in R:V
vengono riportate solo le combinazioni rimaste in A1:E500.000 e pertanto la riga 1 3 4 5 10 del tuo esempio non è riportata perchè non presente in A:E.
Ciao e buon fine settimana a tutti.
Gio

[Anthony47]

è possibile con una macro confrontare velocemente circa 500.000 combinazioni A:E (prima serie Base) con altrentante combinazioni, o meno o più, scritte sullo stesso foglio L:P (o altro foglio) cancellando sulla Base A:E le combinazioni in comune?

Io mi ero attenuto a questo.

Ciao a tutti

[gikeleva]

Buongiorno,
vorrei, se possibile, approfittare ancora della vostra benevolenza:
e se invece volessi riportare, sempre velocemente in R:V solo le combinazioni presenti sia in A:E che in L:P?
Ciao, e buon week end a tutti.
Gio

[Anthony47]

Prova cambiando da
If errNum = 5 Then 'missing...
a
If not errNum = 5 Then 'missing...

Ciao

[gikeleva]

Grazie, perfetto.
Ciao e buona giornata.
Gio