I fattori sono molteplici: velocità Pc, impegno CPU, versione di office etc etc.
Comunque ho pensato di realizzare qualcosa che, orientativamente, fornisce un calcolo ma non so fino a che punto potrà essere vicino a quello reale.
Inserisci un nuovo modulo nel Vba e in esso incollerai l'intero codice
- Codice: Seleziona tutto
Public T1, T2, T3 As Double
Sub CalcAmbi23()
Inizio1 = Timer
Application.ScreenUpdating = False
Application.Calculation = xlManual
Ws1 = "Foglio1"
Worksheets(Ws1).Range("M3:M12").ClearContents
URA = Worksheets(Ws1).Range("A" & Rows.Count).End(xlUp).Row / 10
For RRC1 = 3 To 3
For RRA = 3 To URA
MyC1 = 0
MyC2 = 0
MyCA = 0
MyC1 = Evaluate("=SUM(COUNTIF(" & Ws1 & "!C" & RRA & ":G" & RRA & "," & Ws1 & "!J" & RRC1 & "))")
MyC2 = Evaluate("=SUM(COUNTIF(" & Ws1 & "!C" & RRA & ":G" & RRA & "," & Ws1 & "!K" & RRC1 & "))")
MyCA = Evaluate("=SUM(COUNTIF(" & Ws1 & "!C" & RRA & ":G" & RRA & "," & Ws1 & "!L" & RRC1 & "))")
If MyC1 + MyCA = 2 Then Worksheets(Ws1).Range("M" & RRC1).Value = Worksheets(Ws1).Range("M" & RRC1).Value + 1
If MyC2 + MyCA = 2 Then Worksheets(Ws1).Range("M" & RRC1).Value = Worksheets(Ws1).Range("M" & RRC1).Value + 1
Next RRA
Next RRC1
T1 = (Timer - Inizio1) * 10 * 10
CalcAmbi24
CalcAmbi35
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Msss = "Il Tempo previsto è di " & Int((T1 + T2 + T3) * 0.95) & " Sec circa. Vuoi effettuare la ricerca?"
Risp = MsgBox(Msss, vbYesNo)
If Risp = 6 Then
TrovaAmbi23
End If
End Sub
Private Sub CalcAmbi24()
Inizio2 = Timer
Worksheets(Ws1).Range("N15:N20").ClearContents
URA = Worksheets(Ws1).Range("A" & Rows.Count).End(xlUp).Row / 10
For RRC1 = 15 To 15
For RRA = 3 To URA
MyC1 = 0
MyC2 = 0
MyCA = 0
MyCA2 = 0
MyC1 = Evaluate("=SUM(COUNTIF(" & Ws1 & "!C" & RRA & ":G" & RRA & "," & Ws1 & "!J" & RRC1 & "))")
MyC2 = Evaluate("=SUM(COUNTIF(" & Ws1 & "!C" & RRA & ":G" & RRA & "," & Ws1 & "!K" & RRC1 & "))")
MyCA = Evaluate("=SUM(COUNTIF(" & Ws1 & "!C" & RRA & ":G" & RRA & "," & Ws1 & "!L" & RRC1 & "))")
MyCA2 = Evaluate("=SUM(COUNTIF(" & Ws1 & "!C" & RRA & ":G" & RRA & "," & Ws1 & "!M" & RRC1 & "))")
If MyC1 + MyCA = 2 Then Worksheets(Ws1).Range("N" & RRC1).Value = Worksheets(Ws1).Range("N" & RRC1).Value + 1
If MyC1 + MyCA2 = 2 Then Worksheets(Ws1).Range("N" & RRC1).Value = Worksheets(Ws1).Range("N" & RRC1).Value + 1
If MyC2 + MyCA = 2 Then Worksheets(Ws1).Range("N" & RRC1).Value = Worksheets(Ws1).Range("N" & RRC1).Value + 1
If MyC2 + MyCA2 = 2 Then Worksheets(Ws1).Range("N" & RRC1).Value = Worksheets(Ws1).Range("N" & RRC1).Value + 1
Next RRA
Next RRC1
T2 = (Timer - Inizio2) * 10 * 6
End Sub
Private Sub CalcAmbi35()
Inizio3 = Timer
Worksheets(Ws1).Range("O23:O26").ClearContents
URA = Worksheets(Ws1).Range("A" & Rows.Count).End(xlUp).Row / 10
For RRC1 = 23 To 23
For RRA = 3 To URA
MyC1 = 0
MyC2 = 0
MyCA = 0
MyCA2 = 0
MyCA3 = 0
MyC1 = Evaluate("=SUM(COUNTIF(" & Ws1 & "!C" & RRA & ":G" & RRA & "," & Ws1 & "!J" & RRC1 & "))")
MyC2 = Evaluate("=SUM(COUNTIF(" & Ws1 & "!C" & RRA & ":G" & RRA & "," & Ws1 & "!K" & RRC1 & "))")
MyCA = Evaluate("=SUM(COUNTIF(" & Ws1 & "!C" & RRA & ":G" & RRA & "," & Ws1 & "!L" & RRC1 & "))")
MyCA2 = Evaluate("=SUM(COUNTIF(" & Ws1 & "!C" & RRA & ":G" & RRA & "," & Ws1 & "!M" & RRC1 & "))")
MyCA3 = Evaluate("=SUM(COUNTIF(" & Ws1 & "!C" & RRA & ":G" & RRA & "," & Ws1 & "!N" & RRC1 & "))")
If MyC1 + MyCA + MyCA2 = 3 Then Worksheets(Ws1).Range("O" & RRC1).Value = Worksheets(Ws1).Range("O" & RRC1).Value + 1
If MyC1 + MyCA + MyCA3 = 3 Then Worksheets(Ws1).Range("O" & RRC1).Value = Worksheets(Ws1).Range("O" & RRC1).Value + 1
If MyC1 + MyCA2 + MyCA3 = 3 Then Worksheets(Ws1).Range("O" & RRC1).Value = Worksheets(Ws1).Range("O" & RRC1).Value + 1
If MyC2 + MyCA + MyCA2 = 3 Then Worksheets(Ws1).Range("O" & RRC1).Value = Worksheets(Ws1).Range("O" & RRC1).Value + 1
If MyC2 + MyCA + MyCA3 = 3 Then Worksheets(Ws1).Range("O" & RRC1).Value = Worksheets(Ws1).Range("O" & RRC1).Value + 1
If MyC2 + MyCA2 + MyCA3 = 3 Then Worksheets(Ws1).Range("O" & RRC1).Value = Worksheets(Ws1).Range("O" & RRC1).Value + 1
Next RRA
Next RRC1
T3 = (Timer - Inizio3) * 10 * 4
End Sub
A questo punto dovrai avviare la macro "Sub CalcAmbi23"
N.b, la presente macro fa il calcolo con le tabelle originali (prima richiesta) quindi con 10 righe per la prima tabella, 6 per la seconda e 4 per la terza se le condizioni sono cambiate il tempo calcolato sarà notevolmente diverso da quello effettivo