Ciao anthony, un saluto carissimo, e da molto tempo che non ti leggo, ogni tanto faccio una capatina, però dall'ultima volta è passato proprio molto tempo.
Tempo fa ho avuto anche io il problema di un confronto tra due colonne, e per la verità non trovavo mai nessuna formula che mi soddisfacesse, restava sempre qualcosa da fare, o non riportava tutti i dati, oppure li saltava proprio, ammettendo che alcuni dati erano presenti sulla seconda colonna e non sulla prima, non li prendeva in esame.
Per tagliare la testa al toro, mi sono creato questa UDF, che ti metto a disposizione, per gli usi che ne vorrai fare, ed anche per gli utenti del forum, si tratta della macro per lanciare la UDF e la funzione vera e propria.
Basta inserire il numero delle colonne separate da punti e della colonna del risultato, mettendo il confronto sulle colonne "A-B" ed il risultato sulla "D", basta scrivere nell'InputBox "1.2.4" senza apici ed avrai tutte le voci univoche delle colonne "A-B", nella colonna "D", ecco il codice.
- Codice: Seleziona tutto
Sub confronta()
x = InputBox("Inserire le colonne separate dal Punto " & Chr(10) & "le prime due da Comparare la terza per il risultato")
If x = "" Then Exit Sub
Call CnfrCol(x)
End Sub
Public Function CnfrCol(Dat1)
Dim dat(1 To 3)
n = 1
dx = Len(Dat1) + 1
For x = 1 To dx
c1 = Mid(Dat1, x, 1)
If c1 = "." Or x = dx Then
dat(n) = Val(c2)
c2 = ""
n = n + 1
Else
c2 = c2 + c1
End If
Next x
x1 = dat(1)
x2 = dat(2)
x3 = dat(3)
n1 = 2
r1 = Cells(Rows.Count, x1).End(xlUp).Row
r2 = Cells(Rows.Count, x2).End(xlUp).Row
If r1 = r2 Then rx = r1
If r1 < r2 Then rx = r2
If r1 > r2 Then rx = r1
For x = 2 To rx
xa = Cells(x, x1)
For Z = 2 To rx
If xa = "" Then Exit For
If xa = Cells(Z, x2) Then
If n1 = 2 Then
Cells(n1, x3) = xa
Else
trov = 0
For y = 2 To n1
If xa = Cells(y, x3) Then
trov = 1
Exit For
End If
Next y
If trov = 0 Then
Cells(n1, x3) = xa
n1 = n1 + 1
End If
End If
Else
trov = 0
For y = 2 To n1
If xa = Cells(y, x3) Then
trov = 1
Exit For
End If
Next y
If trov = 0 Then
Cells(n1, x3) = xa
n1 = n1 + 1
End If
End If
Next Z
Next x
For x = 2 To rx
xa = Cells(x, x2)
For Z = 2 To n1
If xa = "" Then Exit For
trov = 0
For y = 2 To n1
If xa = Cells(y, x3) Then
trov = 1
Exit For
End If
Next y
If trov = 0 Then
Cells(n1, x3) = xa
n1 = n1 + 1
End If
Next Z
Next x
End Function
Un saluto ed a rileggerci, Ciao By Sal