Modificar macro en excel para mejoramiento
Para dante amor
Tengo dos macros que hacen lo siguiente.
La primera macro me busca dos coincidencias de un numero de cuatro cifras perfectamente pero de un solo numero y la segunda macro hace lo mismo pero busca las coincidencias de varios números de cuatro cifras colocados en la primera fila pero comete un error ya que resalta con color azul coincidencias que no van al caso y no me muestra todas las coincidencias como lo hace la primera macro como puedo hacer para que la segunda macro se ejecute perfectamente como la primera y se extiende como lo hace la segunda en conclusión quiero que la segunda macro funcione como la primera pero que pueda extenderse colocando los números en la primera fila
La primera macro me funciona muy bien busca las coincidencias pero de un solo numero
Sub primera macro()
Dim n As Range
Dim lookup
'se solicita ingreso del nro de 4 dígitos
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 AH1 y se da formato a la celda
With [AB1]
.Value = lookup
.NumberFormat = "0000"
.Font.Bold = True
.HorizontalAlignment = xlLeft
.Interior.ColorIndex = 44 '(naranja)
End With
'se recorre el rango buscando las 6 coincidencias
'se limpia la col AG
Columns("AA:AA").Clear
x = 2
For Each n In Range("A1:X40")
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 AG
Range("AA" & x) = n
x = x + 1
Else 'opcional quitar color a los no coincidentes.
n.Interior.Color = xlNone
End If
Next n
MsgBox "Fin del proceso.", , "INFORMACIÓN"
End Sub
Y esta es la segunda macro la que quiero mejorar buscando las coincidencias de dos cifras como lo hace la primera pero expandiéndose colocando números en la primera fila
Sub segundamacro()
'---- Variables modificables:
'=== JHON, modifica estos datos de acuerdo a tu planilla:
RangoNum = "U1" 'celda inicial donde están los números a analizar
RangoBusq = "F1:S41"
'CeldaDest = "C1" 'celda a partir de la cual listar los valores coincidentes
ElColor = 33 'color a dar a las celdas con coincidencias. Cero para que quede en blanco
Cifras = 2 ' cantidad cifras considerar para comparar <<<<<
'---- fin Variables
'
'---- inicio de rutina:
'
'limpia datos bajo las columnas
Range(Range(RangoNum).Offset(1, 0), Range(RangoNum).Offset(60000, 150)).ClearContents
'coloca mensaje de cantidad de cifras usadas:
Range(RangoNum).Offset(1, -1).Value = "Coincidencias tomadas de a " & Cifras & "cifra" & IIf(Cifras > 2, "s", "")
Range(RangoNum).Offset(1, -1).HorizontalAlignment = xlRight
Set RangoNums = Range(RangoNum, Range(RangoNum).Offset(, Range(RangoNum).CurrentRegion.Columns.Count - 1))
RangoNums.Interior.ColorIndex = 0
col = 0
For Each Numero In RangoNums
Numero.Interior.ColorIndex = ElColor
Application.ScreenUpdating = False
fila = 1
If Len(Numero) Then
For Each valor In Range(RangoBusq)
If valor > 0 Then
For pos = 1 To Len(valor)
CifraV = Mid(valor, pos, Cifras)
CifraN = Mid(Numero, pos, Cifras)
If Len(CifraV) = Cifras Then
If CifraV = CifraN Then
Range(RangoNum).Offset(fila, col).Value = valor
valor.Interior.ColorIndex = ElColor
fila = fila + 1
cont = cont + 1
Exit For
End If
Else
Exit For
End If
Next
End If
Next
End If
col = col + 1
Application.ScreenUpdating = True
Next
ElMensaje = IIf(cont = 0, "NO SE ENCONTRÓ NUMERO PARA AGREGAR", "Cantidad Total de números agregados " _
& cont & " número" & IIf(cont > 1, "s", "") & Chr(10) & "a una lista de " & linea & " números")
ElTitulo = "TERMINADO!"
MsgBox ElMensaje, vbInformation, ElTitulo
Set RangoNum = Nothing
End Sub
agrego imagen
