Non ho utilizzato la macro precedente perché non si può utilizzare un codice realizzato per una situazione in un'altra disposizone di dati con uno schema "stravolto", tanto più perché mi sembra che mi hai detto in MP di aver provato a ritoccare la macro senza riuscire nell'intento.
"Per tagliare la testa al toro", una volta provata e appurato che non era funzionante, ho realizzato la macro per il Ritardo Attuale come mi hai chiesto (pensando anche che all'occorrenza l'avresti integrata con la precedente).
Quindi ora ho modificato la macro "AnaRit2" adattandola ad ambedue le esigenze e puoi sostituire la precedente con questa nuova macro
L'intero codice mette in ordine il Ritardo Attuale come da tua prima richiesta ma che assegna il Massimo Ritardo come da tua ultima richiesta.
- Codice: Seleziona tutto
Sub AnaRit2()
UE = Range("E" & Rows.Count).End(xlUp).Row
For Num = 1 To 90
RitM = 0
M_RitM = -1
RitA = -1
Passo = 0
M_RitA = ""
For RR = UE To 2 Step -1
RitA = RitA + 1
For CC = 5 To 11
If Num = Cells(RR, CC).Value Then
If Passo = 0 Then M_RitA = RitA
Passo = 1
RitM = -1
End If
Next CC
RitM = RitM + 1
If M_RitM < RitM Then M_RitM = RitM
Next RR
If M_RitA = "" Then M_RitA = UE - 1
Cells(Num + 1, 20).Value = M_RitA
Cells(Num + 1, 17).Value = M_RitM
Next Num
Range("S2").FormulaR1C1 = "1"
Range("S3").FormulaR1C1 = "2"
Range("S2:S3").Select
Selection.AutoFill Destination:=Range("S2:S91"), Type:=xlFillDefault
Range("L1").Select
Columns("S:T").Select
Selection.Sort Key1:=Range("T2"), Order1:=xlDescending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("L1").Select
For Rc = 2 To 91
Numero = Cells(Rc, 20).Value
Numero = Numero Mod 7
Cells(Rc, 20).Font.ColorIndex = Numero * 3 + 3
Next Rc
Call Ordina
End Sub
Sub Ordina()
UE = Range("M" & Rows.Count).End(xlUp).Row
For OO = 2 To UE
ORA = Range("S" & OO).Value
For OFM = 2 To UE
If ORA = Range("M" & OFM).Value Then
Range("U" & OO).Value = Range("N" & OFM).Value
Range("V" & OO).Value = Range("Q" & OFM).Value
GoTo SaltaF
End If
Next OFM
SaltaF:
Next OO
End Sub
Ciao