V3.18
la torre del lotto estero necessita di un nuovo livello
ho studiato la macro "sfaldamento" usato x 10elotto 5 min
ed ho tentato di applicarla/adattarla, in questo file x ottenere lo stesso risultato, nel fgl "sfaldamento2"
la macro non mi da errore ma non mi riporta i numeri correttamente.
la mia macro "sfaldamento2" si trova nel modulo1ed e' la seguente:
- Codice: Seleziona tutto
Sub Sfaldamento2()
Sheets("Archivio_UK49s").Visible = True
Sheets("Archivio_UK49s").Select
Worksheets("calendario").Unprotect
Sheets("sfaldamento2").Select
Application.Calculation = xlManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Set Ws1 = Worksheets("Archivio_UK49s")
Set Ws5 = Worksheets("Sfaldamento2")
Ws5.[AA1] = Int(Timer)
URC = Ws1.Range("C" & Rows.Count).End(xlUp).Row + 1
Ws5.Range("E6:t6000").ClearContents
UR1 = URC
Ws1.Range("c3:i" & UR1).Copy
Sheets("Sfaldamento2").Select
Range("f6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
UR5 = Ws5.Range("F" & Rows.Count).End(xlUp).Row
For R5a = 6 To UR5 - 1
MiaR = R5a
If Ws5.Range("F" & R5a).Value = "--" Then Ws5.Range("F" & R5a & ":l" & R5a).ClearContents: GoTo saltaR5a
If Evaluate("=Count(F" & R5a & ":l" & R5a & ")") > 0 Then
For R5b = R5a + 1 To UR5
If Evaluate("=Count(F" & R5b & ":l" & R5b & ")") > 0 Then
If Evaluate("=Count(F" & R5a & ":l" & R5a & ")") = 0 Then GoTo saltaR5a
Mycount = Evaluate("=SUM(COUNTIF(F" & R5a & ":l" & R5a & ",F" & R5b & ":l" & R5b & "))")
Ws5.Cells(R5a, 13).Value = R5b - MiaR
If Mycount > 0 Then
Conta = 0
Tb = 6
For C5a = 6 To 12
If Ws5.Cells(R5a, C5a).Value = "" Then GoTo saltaCa
For C5b = Tb To 12
If Ws5.Cells(R5b, C5b).Value <> "" Then
If Ws5.Cells(R5a, C5a).Value >= Ws5.Cells(R5b, C5b).Value Then
If Ws5.Cells(R5a, C5a).Value = Ws5.Cells(R5b, C5b).Value Then
Ws5.Cells(R5a, C5a).ClearContents
Conta = Conta + 1
Ws5.Cells(R5a, 13).Value = 0
MiaR = R5b
If Conta = Mycount Then GoTo saltaR5b
Tb = C5b + 1
GoTo saltaCa
End If
Else
GoTo saltaCa
End If
End If
Next C5b
saltaCa:
Next C5a
End If
End If
saltaR5b:
Next R5b
End If
saltaR5a:
If Evaluate("=Count(F" & R5a & ":l" & R5a & ")") = 0 Then
Ws5.Cells(R5a, 13).Value = ""
Else
Ws5.Cells(R5a, 15).Value = Evaluate("=Count(F" & R5a & ":l" & R5a & ")")
End If
Next R5a
Ws5.Range("m" & UR5).Value = 0
Ws5.Range("AB" & UR5).Value = 20
'....TrovaRC
[AB1] = Int(Timer)
[AC1] = [AB1] - [AA1]
Ws5.Range("E" & UR1).Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
ma in fgl sfaldamento 2 mi compila solo le ultime 90 righe circa
inoltre non mi elimina correttamente i numeri gia estratti.
(mi basterebbe anche di verificare solo lo sfaldamento sulle ultime 1.000 estrazioni).
per quanto riguarda la macro "trova RC" non sono proprio riuscito
a sistemarla dato che nel fgl archivio 49k le righe aumentano di 2 al giorno...
grazie e ciao
vi allego il file
https://rapidshare.com/files/4064467828/luga.49k_v3.18_-_Copia.rar
S.O. win10, Excell 2019