Ho una macro che conta nell’archivio tutti i valori delle terzine e poi li scrive sul foglio Terni in colonna H partendo dalla cella H3. Questa macro è nata per i terni del Super Enalotto in un modulo del foglio e io l’ho messa in un modulo standard e l’ho modificata (come ho saputo) per i terni del lotto. Ormai da anni che la uso normalmente è sembra che è tutto ok.
Adesso la vorrei inserire in una procedura automatica dove in archivio ci sono migliaia di righe di cinquine, sempre in aumento, ma è molto lenta quindi l’aiuto che cerco è, se possibile, velocizzare il più possibile.
Attualmente per 120.000 cinquine, presenti nell’archivio range G2:K(end) impiega 1 ora e rotti quindi non molto felice in velocità. Aggiungo oltre ai riferimenti già scritti per l’archivio che è sul foglio Archivio anche i terni sul foglio Terni. Le 117.480 terzine iniziano dal range E3:G117482 e come scritto i valori in colonna H iniziando da H3:H117482. Allego un foglio per eventuale prove. Se non si riesce a modificare la macro proposta e, ci sono altri suggerimenti, sono molto apprezzati e graditi. Ringraziando anticipatamente tutti colore che mi aiuteranno. 73 ikwae
http://www.filedropper.com/velocizzaremacroterni
- Codice: Seleziona tutto
Sub FREQUENZA_TERNI()
'DISATTIVO LE APPLICAZIONI
Dim xlCal As XlCalculation
With Application
.ScreenUpdating = False
.EnableEvents = False
xlCal = .Calculation
.Calculation = xlCalculationManual
End With
Dim aTotTerni() As Variant, aTabellone() As Variant, aNew(1 To 117480, 1 To 1) As Variant
Dim lRiga1 As Long, lRiga2 As Long
Dim iN1 As Integer, iN2 As Integer, iN3 As Integer, iTot As Integer, nSortSI As Integer, nSortNO As Integer, iCol As Integer
Dim T As Date
Dim WS1 As Worksheet, WS2 As Worksheet
Set WS1 = Sheets("Terni")
Set WS2 = Sheets("Archivio")
T = Now
With WS1
'sestine
'aTabellone = WS2.Range("G2:L" & WS2.Range("L" & Rows.Count).End(xlUp).Row)
'cinquine
aTabellone = WS2.Range("G2:K" & WS2.Range("K" & Rows.Count).End(xlUp).Row)
aTotTerni = .Range("E3:G117482")
.Range("H3:H117482").ClearContents
For lRiga1 = LBound(aTotTerni) To UBound(aTotTerni)
iN1 = aTotTerni(lRiga1, 1)
iN2 = aTotTerni(lRiga1, 2)
iN3 = aTotTerni(lRiga1, 3)
For lRiga2 = LBound(aTabellone) To UBound(aTabellone)
'sestine
'For iCol = 1 To 6
'cinquine
For iCol = 1 To 5
If aTabellone(lRiga2, iCol) = iN1 Or _
aTabellone(lRiga2, iCol) = iN2 Or _
aTabellone(lRiga2, iCol) = iN3 Then
nSortSI = nSortSI + 1
If nSortSI = 3 Then
iTot = iTot + 1
Exit For
End If
Else
nSortNO = nSortNO + 1
If nSortNO = 4 Then Exit For
End If
Next iCol
nSortSI = 0
nSortNO = 0
Next lRiga2
aNew(lRiga1, 1) = iTot
iTot = 0
Next lRiga1
.Range("H3:H117482") = aNew()
.Range("A1").Select
End With
Set WS1 = Nothing
Set WS2 = Nothing
'RIATTIVO LE APPLICAZIONI
With Application
.Calculation = xlCal
.EnableEvents = True
.ScreenUpdating = True
End With
Range("A1").Select
MsgBox Format(Now - T, "HH:MM:SS"), vbInformation, "codice eseguito in........."
End Sub