Al seleccionar celda extraer sus dígitos automáticamente
Necesito dos favores, la idea es que al seleccionar una celda numérica de 4 dígitos del rango "af1;aj42" esta automáticamente extraiga sus cifras a la columna "a1, b1, c1, d1" como se muestra en la imagen
Y lo segundo como puedo quitarle el msgbox a este código para que se ejecute libremente
Sub coinxidencias()
'ajustada x Elsamatilde
Application.ScreenUpdating = False
Dim n As Range
Dim lookup
'necesito que se ejecute sin este mensaje solo directamente
lookup = Format(Val(InputBox("ingrese NUMERO de referencia", "BUSQUEDA DE COINCIDENCIAS")), "0000")
If Len(lookup) <> 4 Then
MsgBox "Número no válido.", , "ERROR"
Exit Sub
End If
'se guarda en a1 y se da formato a la celda
With [H1]
.Value = lookup
.NumberFormat = "@"
.Font.Bold = True
.HorizontalAlignment = xlLeft
.Interior.ColorIndex = 44 '(naranja)
End With
'se recorre el rango buscando las 6 coincidencias
'se limpia la col aa
Columns("A:A").Clear ' hay que quitar esta parte o que se oculte
x = 2
For Each n In Range("AF1:AJ42")
If n = lookup Or Left(n.Value, 2) = Left(lookup, 2) Or Right(n.Value, 2) = Right(lookup, 2) Or _
(Left(n.Value, 1) = Left(lookup, 1) And Right(n.Value, 1) = Right(lookup, 1)) Or _
(Left(n.Value, 1) = Left(lookup, 1) And Mid(n.Value, 3, 1) = Mid(lookup, 3, 1)) Or _
(Mid(n.Value, 2, 1) = Mid(lookup, 2, 1) And Right(n.Value, 1) = Right(lookup, 1)) Or _
(Mid(n.Value, 2, 1) = Mid(lookup, 2, 1) And Mid(n.Value, 3, 1) = Mid(lookup, 3, 1)) Then
n.Interior.ColorIndex = 4
'se agrega el nro a la col aa
Range("AB" & x) = n 'hay que quitar o ocultar esta parte
x = x + 1
Else 'opcional quitar color a los no coincidentes.
n.Interior.Color = xlNone
End If
Next n
Application.ScreenUpdating = True
Call buscar_reemplazar_color
'10-08: 'ya se tiene lista en col sin duplicados ni X.
End Sub
2 Respuestas
I.Hola Jhon Fredy, por mi parte no sé como orientarle en este procedimiento pero quería dejarle algunas consultas y tutoriales sobre el tema que tal vez puedan serle de ayuda hasta que le conteste un experto. Le ruego disculpe la imprecisión y todas las molestias de tanta lectura, ánimo.
https://stackoverflow.com/questions/53304598/excel-extract-specific-number-from-cell
https://www.reddit.com/r/excel/comments/qgzjq9/extracting_numbers_from_a_cell_with_numbers_and/
Jhon, te hago constar que no tengo ni idea de Excel, pero lo que se dice ni idea. Pero por si te puede dar unan idea, tienes las funciones
Izquierda, derecha y Extrae
Supongamos que en la celda F1 tienes el numero 6329.
Si en la celda A1 pones
=izquierda(F1;1) te mostrará el 6
Si le pones
= Extrae(F1;2;1) te mostrará el 3
Si le pones
=Extrae(F1;3;1) te mostrará el 2
Si le pones
=Derecha(F1;1) te mostrará el 9
En el caso del mensaje bastaría con que suprimieras el If.... then....End if
Pero ya te digo que esto no es lo mío.