Sub controllauguali() Dim i As Long Dim ur As Long Dim riga As Long riga = 1 ur = Cells(Rows.Count, 2).End(xlUp).Row For i = 1 To ur If WorksheetFunction.CountIf(Range("c:c"), Range("B" & i).Value) > 0 And WorksheetFunction.CountIf(Range("F:f"), Range("B" & i).Value) = 0 Then Cells(riga, 6).Value = Range("b" & i) riga = riga + 1 End If Next i End Sub
Sub Uguali() Dim r, c, d, x, y, dd As New Collection r = 1 c = 4 Range("D:D").Clear For x = 1 To Cells(Rows.Count, 2).End(xlUp).Row d = Cells(x, 2) On Error Resume Next dd.Add d, CStr(d) On Error GoTo 0 Next x For x = 1 To dd.Count d = Val(dd(x)) For y = 1 To Cells(Rows.Count, 3).End(xlUp).Row If d = Cells(y, 3) Then Cells(r, c) = d: r = r + 1: Exit For Next y Next x Range("D1").CurrentRegion.Sort key1:=Range("D1"), order1:=xlAscending End Sub