Macro en excel para buscar coincidencias numéricas
Tengo unos datos numéricos de rango "f1 a Q40" lo que necesito es una macro que cumpla las siguientes condiciones que busque las 6 coincidencias de 2 cifras que serian la primera cifra y la ultima, la segunda cifra y la cuarta, la primera y la tercera, la segunda y la tercera, las dos primeras, y finalmente las dos ultimas
Ejemplo: las coincidencias a buscar del numero 8452 serian la primera y ultima 8272, segunda cifra y cuarta 9462,la primera y la tercera 8650, la segunda y la tercera cifra 6454, las dos primeras 8475, y las dos ultimas 6352
2 Respuestas
Intentando desarrollarte la nueva consulta (con filtros) revisé tus consultas anteriores buscando mayores aclaraciones... y veo que aquí has preguntado algo similar y la macro enviada por William es totalmente correcta, no encontré cifras que no resuelva. Prueba con 1000 y verás que también se cumple en color negro.
Quizás no sea lo que querías obtener... pero así es cómo lo planteaste y la respuesta sí es correcta...( entiendo que merece ser valorada ;)
Sdos!
antes se ejecutaba pero ahora me pide el nombre de la macro y al darle cualquier nombre me solicita end que problema es
El experto William la colocó en el objeto Thisworkbook, por lo que se ejecuta en 'todas las hojas' al realizar un cambio en celda A1.
Tenés otras opciones que quizás sean más apropiadas para tu caso:
1 - Si solo se va a ejecutar en una hoja, colocá el código en el objeto HOJA y las primeras líneas te quedarían así. Se ejecuta al cambio en A1.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim n As Range
Dim lookup As Long
lookup = Range("A1")
For Each n In Range("F1:Q40")El resto queda todo igual. Y solo se ejecutará en la hoja donde colocaste el código.
2 - Si querés ejecutarlo desde un botón o con un atajo de teclado, insertá un módulo y allí colocarás la macro. En este caso va algo modificada.
Sub coincidencias()
'ajustada x Elsamatilde
Dim n As Range
Dim lookup As Long
lookup = Range("A1")
For Each n In Range("F1:Q40")
If n = lookup Then
n.Font.Color = vbWhite
n.Interior.Color = vbBlack
ElseIf Left(n.Value, 2) = Left(lookup, 2) Then
n.Font.Color = vbWhite
n.Interior.Color = vbGreen
ElseIf Right(n.Value, 2) = Right(lookup, 2) Then
n.Font.Color = vbWhite
n.Interior.Color = vbBlue
ElseIf Left(n.Value, 1) = Left(lookup, 1) And Right(n.Value, 1) = Right(lookup, 1) Then
n.Font.Color = vbBlack
n.Interior.Color = vbYellow
ElseIf Left(n.Value, 1) = Left(lookup, 1) And Mid(n.Value, 3, 1) = Mid(lookup, 3, 1) Then
n.Font.Color = vbBlack
n.Interior.Color = vbCyan
ElseIf Mid(n.Value, 2, 1) = Mid(lookup, 2, 1) And Right(n.Value, 1) = Right(lookup, 1) Then
n.Font.Color = vbWhite
n.Interior.Color = vbRed
ElseIf Mid(n.Value, 2, 1) = Mid(lookup, 2, 1) And Mid(n.Value, 3, 1) = Mid(lookup, 3, 1) Then
n.Font.Color = vbWhite
n.Interior.Color = vbMagenta
Else
n.Font.Color = vbBlack
n.Interior.Color = xlNone
End If
Next n
End SubDibujá un botón con la barra Formulario, opción 'Asignar Macro' y le asignás la que se llama 'coincidencias'.
Por supuesto que solo va una de las macros, borrá las que no utilices.
Sdos!
Si los números en dicho rango sera siempre de cuatro cifras, este siguiente código te podría funcionar. Unicamente tiene que ubicarlo en la "ThisWorkbook" en el evento "Sheet Change" tal y como en la imagen siguiente:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim n As Range
Dim lookup As Long
lookup = Sh.Range("A1")
For Each n In Sh.Range("F1:Q40")
If n = lookup Then
n.Font.Color = vbWhite
n.Interior.Color = vbBlack
ElseIf Left(n.Value, 2) = Left(lookup, 2) Then
n.Font.Color = vbWhite
n.Interior.Color = vbGreen
ElseIf Right(n.Value, 2) = Right(lookup, 2) Then
n.Font.Color = vbWhite
n.Interior.Color = vbBlue
ElseIf Left(n.Value, 1) = Left(lookup, 1) And Right(n.Value, 1) = Right(lookup, 1) Then
n.Font.Color = vbBlack
n.Interior.Color = vbYellow
ElseIf Left(n.Value, 1) = Left(lookup, 1) And Mid(n.Value, 3, 1) = Mid(lookup, 3, 1) Then
n.Font.Color = vbBlack
n.Interior.Color = vbCyan
ElseIf Mid(n.Value, 2, 1) = Mid(lookup, 2, 1) And Right(n.Value, 1) = Right(lookup, 1) Then
n.Font.Color = vbWhite
n.Interior.Color = vbRed
ElseIf Mid(n.Value, 2, 1) = Mid(lookup, 2, 1) And Mid(n.Value, 3, 1) = Mid(lookup, 3, 1) Then
n.Font.Color = vbWhite
n.Interior.Color = vbMagenta
Else
n.Font.Color = vbBlack
n.Interior.Color = xlNone
End If
Next n
End Sub
busca algunas pero no cumple con todas las coincidencias que nombre antes
¿Son todos los numero de cuatro dígitos?, porque de lo contrario no funcionara apropiadamente.