Mah, ho penato un po' cercando l'algoritmo giusto, poi ho ripiegato su questi conteggi che comunque sembrano funzionare:
- Codice: Seleziona tutto
Sub rePair()
Dim myArr(), D1 As Long, D2 As Long, D3 As Long, DI1 As Long, DI2 As Long, DI3 As Long, AI As Long
'
Sheets("Foglio1").Select '<<<1 Il foglio di partenza
Sheets("OUTPUT").Cells.ClearContents '<<<2 Il foglio per il riepilogo
last = myLastR(Range("A:F"))
ReDim myArr(1 To last * 3, 1 To 6)
'
AI = 1
For I = 1 To last * 3
If Cells(I - DI1, "A") = "" Then mya = "ZZZC" Else mya = UCase(Cells(I - DI1, "A"))
If Cells(I - DI2, "C") = "" Then myc = "ZZZC" Else myc = UCase(Cells(I - DI2, "C"))
If Cells(I - DI3, "E") = "" Then mye = "ZZZC" Else mye = UCase(Cells(I - DI3, "E"))
If (mya > myc) Or (mya > mye) Then D1 = 1 Else D1 = 0
If (myc > mye) Or (myc > mya) Then D2 = 1 Else D2 = 0
If (mye > mya) Or (mye > myc) Then D3 = 1 Else D3 = 0
If D1 = 0 Then myArr(AI, 1) = Cells(I - DI1, 1): myArr(AI, 2) = Cells(I - DI1, 2)
If D2 = 0 Then myArr(AI, 3) = Cells(I - DI2, 3): myArr(AI, 4) = Cells(I - DI2, 4)
If D3 = 0 Then myArr(AI, 5) = Cells(I - DI3, 5): myArr(AI, 6) = Cells(I - DI3, 6)
AI = AI + 1
If (Cells(I - DI1, "A") = "" And Cells(I - DI2, "C") = "" And Cells(I - DI3, "E") = "") Then
Exit For
End If
DI1 = DI1 + D1: DI2 = DI2 + D2: DI3 = DI3 + D3
Next I
Sheets("OUTPUT").Range("A1").Resize(AI - 1, 6).Value = myArr '<<<2
'
End Sub
Function myLastR(ByRef myArea As Range) As Long
Dim LastR
On Error Resume Next
LastR = myArea.Find(What:="*", After:=myArea.Cells(1, 1), _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
On Error GoTo 0
If IsNumeric(LastR) Then myLastR = LastR
End Function
Il codice va su un "Modulo standard" del progetto vba del tuo file: da Excel premi Alt-F11 per aprire l' editor delle macro; Menu /Inserisci /Modulo; copia il codice e incollalo nel frame di dx.
Poi avvierai la macro rePair: da Excel, premi alt-F8, scegli rePair dall' elenco di macro che ti propone, premi Esegui.
La macro assume che i dati di partenza siano in Foglio1, e l'output sara' creato in un foglio nominato OUTPUT, che deve gia' esistere e che sara' AZZERATO SENZA PREAVVISO all'avvio della macro.
Prova e fai sapere...