quindi sostituisci la macro con questa
- Codice: Seleziona tutto
Sub Ritardi1x2()
UserForm2.Show vbModeless
DoEvents
Inizio = Timer
ActiveSheet.Unprotect
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim E As Integer: Dim J As Integer: Dim R As Integer
Application.ScreenUpdating = False
Application.Calculation = xlManual
Set Ws1 = Sheets("1-masa1-Fogl.Base")
Set Ws2 = Sheets("2-statistiche")
UR = Ws1.Range("P" & Rows.Count).End(xlUp).Row
For RR = UR To 9 Step -1
If Ws1.Range("P" & RR).Value <> "" Then
URE = RR
GoTo salta
End If
Next RR
salta:
ContaR = 0
Conta1 = 0
Conta2 = 0
ContaX = 0
Mconta1 = 0
Mconta2 = 0
McontaX = 0
Ws2.Range("CP9:CP11").ClearContents
For RR = URE To 9 Step -1
If Ws1.Range("P" & RR).Value = 1 Then
Conta1 = 0
Else
Conta1 = Conta1 + 1
If Mconta1 < Conta1 Then Mconta1 = Conta1
End If
If UCase(Ws1.Range("P" & RR).Value) = "X" Then
ContaX = 0
Else
ContaX = ContaX + 1
If McontaX < ContaX Then McontaX = ContaX
End If
If Ws1.Range("P" & RR).Value = 2 Then
Conta2 = 0
Else
Conta2 = Conta2 + 1
If Mconta2 < Conta2 Then Mconta2 = Conta2
End If
If Ws2.Range("CP9").Value = "" And Ws1.Range("P" & RR).Value = 1 Then Ws2.Range("CP9").Value = ContaR
If Ws2.Range("CP10").Value = "" And UCase(Ws1.Range("P" & RR).Value) = "X" Then Ws2.Range("CP10").Value = ContaR
If Ws2.Range("CP11").Value = "" And Ws1.Range("P" & RR).Value = "2" Then Ws2.Range("CP11").Value = ContaR
ContaR = ContaR + 1
Next RR
Ws2.Range("CP15").Value = Mconta1
Ws2.Range("CP16").Value = McontaX
Ws2.Range("CP17").Value = Mconta2
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
ActiveWindow.DisplayGridlines = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingColumns:=True, AllowFormattingRows:=True
Range("Co1").Select
Unload UserForm2
Fine = Timer
MsgBox ("Tempo impiegato " & Int((Fine - Inizio) / 60) & " min " & (Fine - Inizio) Mod 60 & " Sec")
End Sub