Olá, Daniel.
Veja se ajuda.
O código abaixo colocará o resultado a partir de 'L1'.
Sub AgrupaNúmeros()
Dim n As Long, x As Long, LR As Long, c As Long
Dim SE As String, SN As String
LR = Cells(Rows.Count, 10).End(3).Row
Range("J1").Sort Key1:=Range("J1")
For n = 1 To LR
SE = Range(Cells(n, 10), Cells(LR, 10)).Address
SN = Cells(n, 10).Address
x = Evaluate("SUMPRODUCT(--(LEFT(" & SE & ",3)=Left(" & SN & ",3)))")
Cells(c + 1, 12).Resize(, x).Value = _
Application.Transpose(Cells(n, 10).Resize(x).Value)
n = n + x - 1: c = c + 1
Next n
End Sub
Postado : 30/07/2016 7:27 pm