- Codice: Seleziona tutto
Sub ColATQC_E_Storico()
Application.ScreenUpdating = False
Application.Calculation = xlManual
UR = 302
Col = 26
Passo = 68
PassoSt = 23
ColI = 59
ColF = ColI + 54
Worksheets("Foglio1").Select
Range("BG305:LE305").ClearContents
'Range("BG305:IV305").ClearContents
'For Ciclo = 1 To 3
For Ciclo = 1 To 4 ' <- Se hai più di 4 blocchi varia questo valore
Range(Cells(3, ColI + (Ciclo - 1) * Passo), Cells(UR, ColF + (Ciclo - 1) * Passo)).Interior.ColorIndex = xlNone
SR = 0
riga = UR + 13
Col = Col + Passo
For CC = 59 + (Ciclo - 1) * Passo To 113 + (Ciclo - 1) * Passo Step 5
SR = SR + 1
CCS = 1 + PassoSt * (Ciclo - 1) + (SR - 1) * 2
riga = riga + 1
Ambi = 0
Terni = 0
Quaterne = 0
Cinquine = 0
For RR = 3 To UR
EV = 0
ContaA = 0
For CCR = CC + 0 To CC + 4
If Val(Cells(RR, CCR)) > 0 Then
ContaA = ContaA + 1
If ContaA > 1 Then EV = 1
End If
Next CCR
Select Case ContaA
Case 2
Ambi = Ambi + 1
CI = 15
Cells(305, CC + 2).Value = UR - RR
Case 3
Terni = Terni + 1
CI = 4
Cells(305, CC + 2).Select
Cells(305, CC + 2).Value = UR - RR
Case 4
Quaterne = Quaterne + 1
CI = 33
Cells(305, CC + 2).Value = UR - RR
Case 5
Cinquine = Cinquine + 1
CI = 45
Cells(305, CC + 2).Value = UR - RR
Case Else
CI = xlNone
End Select
Range(Cells(RR, CC), Cells(RR, CC + 4)).Interior.ColorIndex = CI
If EV = 1 Then
Conc = Cells(RR, 1)
URS = Worksheets("Storici").Cells(Rows.Count, CCS).End(xlUp).Row
ConcSt = Worksheets("Storici").Cells(URS, CCS).Value
If Conc > ConcSt Then
Worksheets("Storici").Cells(URS + 1, CCS).Value = Conc
Worksheets("Storici").Cells(URS + 1, CCS + 1).FormulaR1C1 = "=RC[-1]-R[-1]C[-1]" '<<<< soluzione con formula
'Worksheets("Storici").Cells(URS + 1, CCS + 1).Value = Conc - ConcSt '<<<<< soluzione con valore
End If
End If
Next RR
Cells(riga, Col).Value = Ambi
Cells(riga, Col + 1).Value = Terni
Cells(riga, Col + 2).Value = Quaterne
Cells(riga, Col + 3).Value = Cinquine
Next CC
Next Ciclo
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub