Macro o función para comparar dígitos entre celdas
Ante todo un saldo y agradecido por su tiempo.
Tengo una columna con datos numéricos. Lo q necesito es q se compare cada celda dentro de la columna en busca de dígitos comunes y en caso de hallarlos me concatene dichos dígitos pero sin repetir el dígito en común. Ejemplo: supongamos tengo esta lista en A1
12
15
29
08
26
entonces:
A1(12) y A2(15) tienen dígito común 1 y me debe concatenar 215 ó 512 (el común al centro)
A1(12) y A3(29) tienen dígito común 2 y me debe concatenar 129 ó 921 (el común al centro)
A1(12) y A5(26) tienen dígito común 2 y me debe concatenar 126 ó 621 (el común al centro)
A3(29) y A5(26) tienen dígito común 2 y me debe concatenar 926 ó 629 (el común al centro)
Seria excelente colocarla como función definida por el usuario, si fuese posible
1. El 12 y el 29 tienen en común el 2, ¿en dónde pondría el resultado?
2. Nuevamente el 12 y el 26 tienen en común el 2, ¿dónde pondría el resultado?
3. ¿Siempre son números de 2 dígitos?
4. El resultado concatenado, ¿tienes 2 opciones cuál pongo?
5. Reviso, por ejemplo, el 12 lo comparo con toda la lista y se encuentra que tiene en común el 2 con el 29, pregunta sigo comparando el 12 con el resto de los números, o si ya encontró un común que se pase al siguiente número.
6. En tu ejemplo, faltaría 29 con 12, ¿26 con 12 y 26 con 29?
Gracias por la atención.
1 y 2) El rango contiene 10 números. Los resultados irán a otro rango
3) Siempre son todos de dos dígitos
4) Colocar las 2 opciones de resultado
5 y 6) Se debe comparar el primero, en este caso 12, con 2do, 3ro, 4to, 5to y asi hasta el ultimo (10mo). Luego el 2do no se va a comparar con el 1ro porque ya se comparo,(ejemplo: 12 y 15 me darían 215 y 512, si hago 15 y 12 dará lo mismo) entonces se hará a partir del 3ro hasta el ultimo. Después ya 1ro y segundo están listos y se sigue con el 3ro y se empieza a comparar a partir del cuarto. dejo el ejemplo completo:
Te anexo la macro
Sub compara_digitos()
'por.dam
k = 2
Range(Cells(2, "B"), Cells(Range("B" & Rows.Count).End(xlUp).Row, "C")).ClearContents
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
If Len(Cells(i, "A")) = 2 Then
dig1 = Left(Cells(i, "A"), 1)
dig2 = Right(Cells(i, "A"), 1)
ElseIf Len(Cells(i, "A")) = 1 Then
dig1 = 0
dig2 = Right(Cells(i, "A"), 1)
Else
dig1 = "A"
End If
If dig1 <> "A" Then
For j = i + 1 To Range("A" & Rows.Count).End(xlUp).Row
If Len(Cells(j, "A")) = 2 Then
dig3 = Left(Cells(j, "A"), 1)
dig4 = Right(Cells(j, "A"), 1)
ElseIf Len(Cells(j, "A")) = 1 Then
dig3 = 0
dig4 = Right(Cells(j, "A"), 1)
Else
dig3 = "B"
End If
If dig3 <> "B" Then
If dig1 = dig3 Then
Cells(k, "B") = "'" & dig2 & dig1 & dig4
Cells(k, "C") = "'" & dig4 & dig1 & dig2
k = k + 1
ElseIf dig1 = dig4 Then
Cells(k, "B") = "'" & dig2 & dig1 & dig3
Cells(k, "C") = "'" & dig3 & dig1 & dig2
k = k + 1
End If
If dig2 = dig3 Then
Cells(k, "B") = "'" & dig1 & dig2 & dig4
Cells(k, "C") = "'" & dig4 & dig2 & dig1
k = k + 1
ElseIf dig2 = dig4 Then
Cells(k, "B") = "'" & dig1 & dig2 & dig3
Cells(k, "C") = "'" & dig3 & dig2 & dig1
k = k + 1
End If
End If
Next
End If
Next
End SubPara este caso
12
21
Las salidas son:
212 y 212 ' el dígito 1 (del primero) se repite con el dígito 2 (del segundo)
121 y 121 'el dígito 2 (del primero) se repite con el dígito 1 (del segundo)
Para este caso
22
24
Las salidas son:
224 y 422
224 y 422
Saludos. Dam
Si es lo que necesitas.
