Visual Basic para Aplicaciones - Buscar en baso a dos o mas criterios VBA

Life is soft - evento anual de software empresarial

Buscar en baso a dos o mas criterios VBA

Publicado por Pool (6 intervenciones) el 16/08/2017 02:00:27

Hola buenas tardes, me pueden ayudar con la sig. linea de codigo lo que estoy buscando hacer es Buscar registros en vase a 2 o mas criterios actualmente tengo este codigo con el que busco en base a un criterio pero no se como modificarlo para que pueda buscar con mas criterios espero puedan ayudarme gracias........

Private Sub B_Buscar_Click()

On Error Resume Next

Text_Denominaciondistintiva.Text = WorksheetFunction.VLookup(Val((Text_Codigo.Text) And (C_Estatus.Text)), Sheets("Productos").Range("B6:T1505"), 3, False)

C_Laboratorio.Text = WorksheetFunction.VLookup(Val(Text_Codigo.Text And C_Estatus.Text), Sheets("Productos").Range("B6:T1505"), 4, False)

Text_RegistroSanitario.Text = WorksheetFunction.VLookup(Val(Text_Codigo.Text), Sheets("Productos").Range("B6:T1505"), 5, False)

C_Forma.Text = WorksheetFunction.VLookup(Val(Text_Codigo.Text), Sheets("Productos").Range("B6:T1505"), 6, False)

C_Administracion.Text = WorksheetFunction.VLookup(Val(Text_Codigo.Text), Sheets("Productos").Range("B6:T1505"), 7, False)

Text_Presentacion.Text = WorksheetFunction.VLookup(Val(Text_Codigo.Text), Sheets("Productos").Range("B6:T1505"), 8, False)

Text_Precio.Text = WorksheetFunction.VLookup(Val(Text_Codigo.Text), Sheets("Productos").Range("B6:T1505"), 9, False)

Text_cualitativa.Text = WorksheetFunction.VLookup(Val(Text_Codigo.Text), Sheets("Productos").Range("B6:T1505"), 10, False)

Text_Cuantitativa.Text = WorksheetFunction.VLookup(Val(Text_Codigo.Text), Sheets("Productos").Range("B6:T1505"), 11, False)

Text_Excipiente.Text = WorksheetFunction.VLookup(Val(Text_Codigo.Text), Sheets("Productos").Range("B6:T1505"), 12, False)

C_Temperatura.Text = WorksheetFunction.VLookup(Val(Text_Codigo.Text), Sheets("Productos").Range("B6:T1505"), 13, False)

C_Humedad.Text = WorksheetFunction.VLookup(Val(Text_Codigo.Text), Sheets("Productos").Range("B6:T1505"), 14, False)

C_Luz.Text = WorksheetFunction.VLookup(Val(Text_Codigo.Text), Sheets("Productos").Range("B6:T1505"), 15, False)

C_Clasificacion.Text = WorksheetFunction.VLookup(Val(Text_Codigo.Text), Sheets("Productos").Range("B6:T1505"), 16, False)

C_Controles.Text = WorksheetFunction.VLookup(Val(Text_Codigo.Text), Sheets("Productos").Range("B6:T1505"), 17, False)

C_Grupo.Text = WorksheetFunction.VLookup(Val(Text_Codigo.Text), Sheets("Productos").Range("B6:T1505"), 18, False)

C_Subgrupo.Text = WorksheetFunction.VLookup(Val(Text_Codigo.Text), Sheets("Productos").Range("B6:T1505"), 19, False)

B_Editar.Enabled = True

End Sub

Valora esta pregunta

Me gusta: Está pregunta es útil y esta clara

No me gusta: Está pregunta no esta clara o no es útil

Responder

Pos: 1

Val: 1.134

Buscar en baso a dos o mas criterios VBA

Publicado por Antoni Masana (498 intervenciones) el 16/08/2017 08:16:19

He dado un poco de formato al código para leerlo mejor y no me gusta.

Private Sub B_Buscar_Click()

    On Error Resume Next

    Text_Denominaciondistintiva.Text = WorksheetFunction.VLookup(Val((Text_Codigo.Text) And (C_Estatus.Text)), Sheets("Productos").Range("B6:T1505"), 3, False)

    C_Laboratorio.Text               = WorksheetFunction.VLookup(Val(Text_Codigo.Text   And C_Estatus.Text)  , Sheets("Productos").Range("B6:T1505"), 4, False)

    Text_RegistroSanitario.Text      = WorksheetFunction.VLookup(Val(Text_Codigo.Text)                       , Sheets("Productos").Range("B6:T1505"), 5, False)

    C_Forma.Text                     = WorksheetFunction.VLookup(Val(Text_Codigo.Text)                       , Sheets("Productos").Range("B6:T1505"), 6, False)

    C_Administracion.Text            = WorksheetFunction.VLookup(Val(Text_Codigo.Text)                       , Sheets("Productos").Range("B6:T1505"), 7, False)

    Text_Presentacion.Text           = WorksheetFunction.VLookup(Val(Text_Codigo.Text)                       , Sheets("Productos").Range("B6:T1505"), 8, False)

    Text_Precio.Text                 = WorksheetFunction.VLookup(Val(Text_Codigo.Text)                       , Sheets("Productos").Range("B6:T1505"), 9, False)

    Text_cualitativa.Text            = WorksheetFunction.VLookup(Val(Text_Codigo.Text)                       , Sheets("Productos").Range("B6:T1505"), 10, False)

    Text_Cuantitativa.Text           = WorksheetFunction.VLookup(Val(Text_Codigo.Text)                       , Sheets("Productos").Range("B6:T1505"), 11, False)

    Text_Excipiente.Text             = WorksheetFunction.VLookup(Val(Text_Codigo.Text)                       , Sheets("Productos").Range("B6:T1505"), 12, False)

    C_Temperatura.Text               = WorksheetFunction.VLookup(Val(Text_Codigo.Text)                       , Sheets("Productos").Range("B6:T1505"), 13, False)

    C_Humedad.Text                   = WorksheetFunction.VLookup(Val(Text_Codigo.Text)                       , Sheets("Productos").Range("B6:T1505"), 14, False)

    C_Luz.Text                       = WorksheetFunction.VLookup(Val(Text_Codigo.Text)                       , Sheets("Productos").Range("B6:T1505"), 15, False)

    C_Clasificacion.Text             = WorksheetFunction.VLookup(Val(Text_Codigo.Text)                       , Sheets("Productos").Range("B6:T1505"), 16, False)

    C_Controles.Text                 = WorksheetFunction.VLookup(Val(Text_Codigo.Text)                       , Sheets("Productos").Range("B6:T1505"), 17, False)

    C_Grupo.Text                     = WorksheetFunction.VLookup(Val(Text_Codigo.Text)                       , Sheets("Productos").Range("B6:T1505"), 18, False)

    C_Subgrupo.Text                  = WorksheetFunction.VLookup(Val(Text_Codigo.Text)                       , Sheets("Productos").Range("B6:T1505"), 19, False)

    B_Editar.Enabled = True

End Sub

En primer lugar y para aclarar las cosas VLookUp (BuscarV) busca el primer parámetro en la primera columna del rango (B) definido como segundo parámetro, hasta aquí de acuerdo.

En las tres primeras búsquedas son diferentes ¿Por que? y más impresionante ¿Que significan las dos primeras?

1- Val((Text_Codigo.Text) And (C_Estatus.Text))

2- Val(Text_Codigo.Text   And C_Estatus.Text)

3- Val(Text_Codigo.Text)

Además este codigo realiza la búsquera 17 veces y esto son muchas veces.

Se puede simplificar y mejorar

Private Sub B_Buscar_Click()

    Dim Lin as integer

    Sheets("Productos").Select

    For Lin=5 to 1505

        If val(Text_Codigo.Text) = Cells(Lin,2) and C_Estatus.Text = Cells(Lin,3) then

            Text_Denominaciondistintiva.Text = Cells(Lin,  4)

            C_Laboratorio.Text               = Cells(Lin,  5)

            Text_RegistroSanitario.Text      = Cells(Lin,  6)

            C_Forma.Text                     = Cells(Lin,  7)

            C_Administracion.Text            = Cells(Lin,  8)

            Text_Presentacion.Text           = Cells(Lin,  9)

            Text_Precio.Text                 = Cells(Lin, 10)

            Text_cualitativa.Text            = Cells(Lin, 11)

            Text_Cuantitativa.Text           = Cells(Lin, 12)

            Text_Excipiente.Text             = Cells(Lin, 13)

            C_Temperatura.Text               = Cells(Lin, 14)

            C_Humedad.Text                   = Cells(Lin, 15)

            C_Luz.Text                       = Cells(Lin, 16)

            C_Clasificacion.Text             = Cells(Lin, 17)

            C_Controles.Text                 = Cells(Lin, 18)

            C_Grupo.Text                     = Cells(Lin, 19)

            C_Subgrupo.Text                  = Cells(Lin, 20)

            B_Editar.Enabled = True

            Exit For

        End If

    Next

end sub

¿Que hace?

- El FOR recorre desde las líneas desde la 5 hasta la 1505
- El IF compara Text_Codigo con el contenido de la Celda de la columna B y el C_Estatus con el contenido de la Celda de la columna C.
- Cuando encuentra una coincidencias pasa el contenido de las celdas a las variables.
- Finaliza el Bucle

Sencillo, limpio y rápido.

Saludos.
\\//_

Valora esta respuesta

Me gusta: Está respuesta es útil y esta clara

No me gusta: Está respuesta no esta clara o no es útil

Comentar

Buscar en baso a dos o mas criterios VBA

Publicado por Jesus Pool (6 intervenciones) el 19/08/2017 20:43:45

Hola, Buen dia, en verdad os lo agradezco por el tiempo que se tomo en contestar el codigo me funciono correctamente lo he estudiado y he notado que si quiero buscar por mas criterios solo hace falta agregar un (and text_Fecha1 = Cells(Lin, 4) y listo, solo tengo una duda cuando intento colocar este parametro de busqueda no me funciona

For Lin = 5 To 200000

Me genera el error Desbordamiento

Para solucionarlo cambie "Integer" por "Long"

Y la Linea quedo asi

Dim lin As Long

Sheets("Ingresos").Select

For lin = 5 To CLng(100000)

No afecta en la line de codigo que me hiciste favor de compartir ...

Gracias

Valora esta respuesta

Comentar

Pos: 1

Val: 1.134

Buscar en baso a dos o mas criterios VBA

Publicado por Antoni Masana (498 intervenciones) el 19/08/2017 22:39:11

En el código que pusiste solo habían 15.000 lineas y utilice el tipo INTEGER, pero si tienes que tratar mas 32.660 lineas como el caso que expones 200.000 cambia la definición de la variable por Long.

Y si quieres no pillarte los dedos con la cantidad de lineas pon esto:

Private Sub B_Buscar_Click()

    Dim Lin as Long

    Sheets("Productos").Select

    For Lin=5 to 2^20

        if Cells(Lin,2) = "" then Exit For

        If val(Text_Codigo.Text) = Cells(Lin,2) and C_Estatus.Text = Cells(Lin,3) then

...

        End If

End Sub

El 2^20 es el numero de lineas que tiene la hoja.
Finaliza el FOR cuando encuentre una celda en la columna B vacía. Esta debe ser una columna que SIEMPRE tenga datos.

Saludos.
\\//_

Valora esta respuesta

Comentar

Buscar en baso a dos o mas criterios VBA

Publicado por Jesus Pool (6 intervenciones) el 19/08/2017 23:17:43

Buen Aporte gracias, estoy programando un boton para editar los datos una vez buscados con un criterio no tengo problema pero con 2 criterios no he logrado hacerlo que consejo me darias este es el codigo que uso para 1 criterio

Private Sub B_Editar_Click()

bus_id = WorksheetFunction.Match(Val(Text_Codigo.Text), Sheets(1).Range("B6:B1505"), 0) + 5

With Sheets("Ingresos")

        .Range("C" & bus_id).Value = Text_Estatus.Text

        .Range("D" & bus_id).Value = Text_Denominaciondistintiva.Text

        .Range("E" & bus_id).Value = Text_Laboratorio.Text

        .Range("F" & bus_id).Value = Text_RegistroSanitario.Text

        .Range("G" & bus_id).Value = Text_Forma.Text

        .Range("H" & bus_id).Value = Text_Administracion.Text

        .Range("I" & bus_id).Value = Text_Presentacion.Text

        .Range("J" & bus_id).Value = Text_Precio.Text

        .Range("K" & bus_id).Value = Text_cualitativa.Text

        .Range("L" & bus_id).Value = Text_Cuantitativa.Text

        .Range("M" & bus_id).Value = Text_Excipiente.Text

Text_Codigo = Empty

C_Estatus = Empty

Text_Denominaciondistintiva = Empty

C_Laboratorio = Empty

Text_RegistroSanitario = Empty

C_Forma = Empty

C_Administracion = Empty

Text_Presentacion = Empty

Text_Precio = Empty

Text_cualitativa = Empty

Text_Cuantitativa = Empty

Text_Excipiente = Empty

Me.MultiPage1.Value = Me.MultiPage1.Value - 3  _Text_Codigo.setfocus

End With

End Sub

Valora esta respuesta

Comentar

proteger informacion de una hoja con contraseña

Error en el método "range" de objeto "_Global"