Gentilmente potete aggiungere la operazione descritta nell'immagine? Grazie, Lucio
Dim I As Integer, Ruote As Integer, Ur As Single
Dim BA As Integer, CA As Integer, FI As Integer, GE As Integer, MI As Integer
Dim NA As Integer, PA As Integer, RO As Integer, TOR As Integer, VE As Integer
Sub Lucio()
Ur = Range("A" & Rows.Count).End(xlUp).Row
'Ur = Range("A65536").End(xlUp).Row
Ruote = 0
I = 2
While I <= Ur
If OldN <> Cells(I, 1) And OldN <> "" Then '<<< *****Aggiunta MODIFICATA
'Ruote = 9: I = I - 1: GoTo NewN '<<< Aggiunta
Ruote = 10: I = I - 1: PLM = 1: GoTo NewN '<<< Aggiunta +A+A+A+A aggiunto PLM
End If
Select Case Cells(I, 2)
Case "Ba"
If BA = 1 Then
Cancella_Doppione I, Ur
Else
BA = 1
Ruote = Ruote + 1
End If
Case "Ca"
If CA = 1 Then
Cancella_Doppione I, Ur
Else
CA = 1
Ruote = Ruote + 1
End If
Case "Fi"
If FI = 1 Then
Cancella_Doppione I, Ur
Else
FI = 1
Ruote = Ruote + 1
End If
Case "Ge"
If GE = 1 Then
Cancella_Doppione I, Ur
Else
GE = 1
Ruote = Ruote + 1
End If
Case "Mi"
If MI = 1 Then
Cancella_Doppione I, Ur
Else
MI = 1
Ruote = Ruote + 1
End If
Case "Na"
If NA = 1 Then
Cancella_Doppione I, Ur
Else
NA = 1
Ruote = Ruote + 1
End If
Case "Pa"
If PA = 1 Then
Cancella_Doppione I, Ur
Else
PA = 1
Ruote = Ruote + 1
End If
Case "Ro"
If RO = 1 Then
Cancella_Doppione I, Ur
Else
RO = 1
Ruote = Ruote + 1
End If
Case "To"
If TOR = 1 Then
Cancella_Doppione I, Ur
Else
TOR = 1
Ruote = Ruote + 1
End If
Case "Ve"
If VE = 1 Then
Cancella_Doppione I, Ur
Else
VE = 1
Ruote = Ruote + 1
End If
End Select
NewN: '<<< Aggiunta
If Ruote = 10 Then
BA = 0: CA = 0: FI = 0: GE = 0: MI = 0: NA = 0: PA = 0: RO = 0: TOR = 0: VE = 0
Ruote = 0
OldN = Cells(I + 1, 1) '*******<<<< AGGIUNTA AGGIUNTA
If PLM = 0 Then Cells(I, 5) = Cells(I, 3) - Cells(I - 1, 3) '<<<< +++++ +A+A+A+A Modificata, era If I>7
'If I > 7 Then Cells(I, 5) = Cells(I, 3) - Cells(I - 1, 3) '<<<< +++++
End If
PLM = 0
I = I + 1
' OldN = Cells(I, 1) '<<< ******Aggiunta MODIFICATA, cioe' tolta
Wend
End Sub
Sub Cancella_Doppione(I, Ur)
Rows(I).Select
Selection.Delete Shift:=xlUp
Ur = Ur - 1
I = I - 1
End Sub