Macro para nuevo proyecto de Excel

A.M

Tiempo sin hablarnos

Me gustaría que pudieras ayudarme con una macro para lo siguiente:

Macro para buscar en una base de datos según un criterio dado y traer sus resultados

2 Respuestas

Respuesta
1

Generalmente para estos tipos de búsqueda utilizo el Filtro Avanzado ya que es más rápido que recorrer la tabla buscando coincidencias.

En algún lugar de tu hoja ConstCol colocá el título de la col D. En mi ejemplo utilicé el rango M1:M2 (ver imagen)

Luego la macro la dejé en el Editor en el objeto HOJA Busqueda, para que se ejecute ni bien cambies el valor de la celda D12.

Private Sub Worksheet_Change(ByVal Target As Range)
'x Elsamatilde
'se ejecuta al cambio en celda D12
If Target.Address <> "$D$12" Then Exit Sub
If Target.Value = "" Then Exit Sub
'se limpia el rango en hoja Búsqueda
If [B16] <> "" Then Range("B15:F" & Range("B" & Rows.Count).End(xlUp).Row).ClearContents
'se coloca el dato en el rango de criterios hoja Const
Set hor = Sheets("ConstCol")
hor.[M2] = Target.Value
'ult fila en tabla origen
finx = hor.Range("A" & Rows.Count).End(xlUp).Row
hor.Range("A1:F" & finx).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=hor.Range( _
        "M1:M2"), CopyToRange:=hor.Range("AA1"), Unique:=True
'se copia sin los títulos si hubiese datos filtrados
If hor.[AA2] <> "" Then
    hor.Range("AA2:AC" & hor.Range("AA" & Rows.Count).End(xlUp).Row).Copy Destination:= _
    ActiveSheet.[B15]
Else
    MsgBox "No se encontraron datos con este criterio."
End If
'limpia col de datos auxiliares
hor.Range("AA:AF").Clear
End Sub

Estoy utilizando un rango auxiliar en hoja Const.Col a partir de col AA que al terminar la macro se limpiará.

Te recuerdo que la consulta sigue abierta... no olvides valorarla (excelente o buena) para darla por cerrada.

Sdos!

Respuesta
1

Dim i As Long
Dim Fila As Double
Dim x As Double

Fila = Hoja1.Range("A65000").End(xlUp).Row

x = 1
For i = 1 To Fila
If InStr(1, Hoja1.Range("B" & i).Value, Hoja2.Range("A1").Value, vbTextCompare) <> 0 Then
Hoja2.Range("A" & x).Value = Hoja1.Range("B" & i).Value
Hoja2.Range("B" & x).Value = Hoja1.Range("C" & i).Value
Hoja2.Range("C" & x).Value = Hoja1.Range("D" & i).Value
x = x + 1
End If
Next i

Este Macro es más Rápido y Corto y puedes moldearlo a tu manera de acuerdo a los rangos que necesitas llevar al libro que quieres ver los resultados. Acá coloque la celda A1 del libro 2 como búsqueda en el libro 1 en la Celda B.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas