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

Life is soft - evento anual de software empresarial
   
Vista:

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........

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
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 claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana

Buscar en baso a dos o mas criterios VBA

Publicado por Antoni Masana (194 intervenciones) el 16/08/2017 08:16:19
He dado un poco de formato al código para leerlo mejor y no me gusta.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
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
2
3
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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
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 claraNo me gusta: Está respuesta no esta clara o no es útil
0
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
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de Antoni Masana

Buscar en baso a dos o mas criterios VBA

Publicado por Antoni Masana (194 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:

1
2
3
4
5
6
7
8
9
10
11
12
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
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
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


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
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
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Revisar política de publicidad