Excek Vba Macro que busque 2 Condiciones con Find Al Mismo Tiempo

Esto es una parte del código.. Mi duda es de que otra forma puedo buscar Implementando 2 condiciones.

'Aquí Buscamos que coincida celda mobre y Fecha de la persona que buscamos

     d1 = UCase(Cells(F0, 2).Value) 'NOMBRE EN HOJA DE ASISTENCIA
     d2 = Cells(F0, 3).Value ' HORA DE HOJA DE ASISTENCIA
     con1 = d1 & d2  aqui juntamos las dos Celdas

    
     d3 = Nombre_Desp 'NOMBRE EN HOJA REPORTE
     d4 = FSI         'FECHA INICIAL
     con2 = d3 & d4    
     If con1 = con2 Then '&&&&

   'COdigo

   End If

El Problema es que tarde mi código como 30 segundos en buscar,¿habrá otra forma del que pueda hacerlo más Rápido?

2 Respuestas

Respuesta
1

La verdad que no veo nada recursivo así que no hay mucho para optimizar. Lo único que se me ocurre es que estés en modo de cálculo automático, por lo que podrías ganar un poco de tiempo si te acostumbrás a trabajar en modo manual por lo demás no entiendo como puede tardar 30'' para ejecutar ese código (salvo que en realidad tengas esa función dentro de un código mucho más complicado y en realidad sea eso lo que tarda).

Respuesta
2

Supongo que tienes un ciclo for o do while, te enviaría la solución completa pero no veo toda la información.

Para hacer una búsqueda más rápida, puedes hacerlo con Find, en la siguiente macro te muestro un ejemplo, traté de adaptar tu código. Lo que hago es buscar el nombre "Nombre_Desp", en la hoja "asistencia", en la columna "B", si lo encuentro, pregunto si la fecha, que se encuentra en la columna "C" es igual a la variable "FSI".

Si son iguales, entonces tengo el registro y envío un mensaje.

Si no son iguales busca el siguiente nombre, cuando revisa todos los nombre termina el ciclo de búsqueda.

Sub buscar()
'Por.Dante Amor
    '
    Set h = Sheets("asistencia")
    Set r = h.Columns("B")
    Set b = r.Find(Nombre_Desp, lookat:=xlWhole)
    If Not b Is Nothing Then
        ncell = b.Address
        Do
            If h.Cells(b.Row, "C") = FSI Then
                MsgBox "encontrado"
                '
                'tu código
                '
                Exit Do
            End If
            Set b = r.FindNext(b)
        Loop While Not b Is Nothing And b.Address <> ncell
    End If
End Sub

Si tienes problemas para adaptarlo a tu archivo avísame, pero tendrás que darme toda la información.

Hola Dante

Mil gracias Por la Respuesta, intento entender lo que hace el código, pero no lo comprendo al 100%.. ¿Te puedo mandar mi código e implementarlo?...

Son como 4 páginas.. a lo mejor la mayoría del código se puede reducir...

¿Solo dime como te lo mando?

Saludos!.

Buen Día!..

Envíame tu archivo con la macro.

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario "kazama2010" y el título de esta pregunta.

Hola Dante

Te Acabo de Mandar mi Archivo

Saludos!.. y Gracias por tu Ayuda!.....

Ahora se tarda 4 segundos

For w = 0 to (dias_nat - 1) '{{{{{{{{ le ponemos un -1 por que empezamos desde 0
    sheets(asis).activate
    'por.dante amor
    set h = sheets(asis)
    set r = h.columns("b")
    set b = r.find(nombre_desp, lookat:=xlwhole)
    if not b is nothing then
        ncell = b.address
        do
            if h.cells(b.row, "c") = fsi then
                'msgbox "encontrado"
                horav = format((cells(b.row, 5).value), "hh:mm:ss")
                horav = timevalue(horav) 'aqui convertimos la variable en hora
                diav = ucase(cells(b.row, 4).value) 'guardamos el dia en letra
                '
                'if horav <= horaent then 'si es menor o igual a la hora de entrada
                if horav <= hora_entrada then 'si es menor o igual a la hora de entrada
                  sheets(report).activate
                    with activecell.offset(0, w)
                         .font.size = 8
                         .value = "aa " & horav
                         .rowheight = 22.5
                         .columnwidth = 4.14
                         .font.bold = true
                         .wraptext = true
                         .horizontalalignment = xlcenter     'centrar cada asistencia o retardo de las personas
                         .verticalalignment = xlcenter
                    end with
                  ban1 = 1      'aqui si encuentra dato que ya no siga buscando
                Elseif (horav < hora_retardo) then 'si menor a la hora de retardo, dentro de la tolerancia
                'elseif (horav > horaent) and (horav < horaret) then 'si es mayor a hora entrada pero menor a la hora de retardo, dentro de la tolerancia
                 sheets(report).activate
                    with activecell.offset(0, w)
                         .font.size = 8
                         .value = "tt " & horav
                         .rowheight = 22.5
                         .columnwidth = 4.14
                         .font.color = rgb(204, 0, 0) 'color rojo
                         .font.bold = true
                         .wraptext = true
                         .horizontalalignment = xlcenter     'centrar cada asistencia o retardo de las personas
                         .verticalalignment = xlcenter
                    end with
                   toler1 = toler1 + 1 'contamos los que llegan dentro del tiempo de tolerancia
                   ban1 = 1
                elseif (horav >= hora_retardo) then 'si es mayor a hora entrada pero menor a la hora de retardo, dentro de la tolerancia
                  sheets(report).activate
                    with activecell.offset(0, w)
                         .font.size = 8
                         .value = "rr " & horav
                         .rowheight = 22.5
                         .columnwidth = 4.14
                         '.entirecolumn.autofit  'autoajustar celda
                         .font.color = rgb(204, 0, 0)
                         .font.bold = true
                         .wraptext = true
                         .horizontalalignment = xlcenter     'centrar cada asistencia o retardo de las personas
                         .verticalalignment = xlcenter
                    end with
                  retar1 = retar1 + 1
                  ban1 = 1
                end if
                sheets(asis).activate 'no quitar evalua en hoja de asistencia
                if (day(cells(b.row, 3))) mod 2 = 0 then
                  par2 = par2 + 1
                else
                  impar2 = impar2 + 1
                end if
                as1 = as1 + 1  'aqui contamos los turnos de cada persona
                '
                exit do
            end if
            set b = r.findnext(b)
        loop while not b is nothing and b.address <> ncell
    end if
    if ban1 = 1 then '*   'aqui si encuentra dato que ya no siga buscando
        ban1 = 0
        '    exit do
    end if '*
    fsi = fsi + 1    'aqui va incrementanto las fecha, va sumando dias
Next w '{{{{{{{{

Saludos.Dante Amor

No olvides valorar la respuesta.

¡Gracias! 

Te Agradezco Tu Ayuda Dante Amor

Saludos!!..

Hola dante

Estuve viendo el Código e intente Entenderlo y Modificarlo..

Solo una duda, que debo hacer en caso de que agregue una columna al principio de la hoja, ¿es decir antes de la columna nombre? Intente modificar el código para que en caso de que ocurra eso.. no le afecte o no ocurra error en el programa...

Y Otro detalle, no entendí muy bien esto

""If Not b Is Nothing Then""   Es lo mismo que esto   ""' If b Is True Then  ""

saludos!!!...

Sub buscar()
'Por.Dante Amor
'Nombre_Desp = "Miguel"
'FSI = DateValue("05-ENE-15")
 

   P = "NOMBRE"
    Set FOUNDCELL = ActiveSheet.Cells.Find(P, lookat:=xlWhole)
    If FOUNDCELL Is Nothing Then
         MsgBox ("Lo Siento,  No Se Encontro Celda   " & P)
         End
     End If
     FOUNDCELL.Select
     C_Nomb = ActiveCell.Column 'NUMERO DE COLUMNA DE NOMBRE
     'F_Nomb = ActiveCell.Row + 1 'NUMERO DE FILA DE NOMBRE
    Set h = Sheets("Hoja1")
    'Set r = h.Columns("B")
    Set r = h.Column(C_Nomb)
    Set b = r.Find(Nombre_Desp, lookat:=xlWhole)
     If Not b Is Nothing Then
     'If b Is True Then  
        ncell = b.Address
        Do
            If h.Cells(b.Row, "C") = FSI Then
           ' If h.Cells(b.Row, (r + 1)) = FSI Then
                  hcell = b.Address
                MsgBox "encontrado"
                '
                'tu código
                '
                Exit Do
                Else
                MsgBox "No Encontrado"
            End If
             hcell = b.Address
            Set b = r.FindNext(b)
        Loop While Not b Is Nothing And b.Address <> ncell
    End If
End Sub

Tendría que revisar en qué hoja quieres poner la columna.

Y esto no es lo mismo:

""If Not b Is Nothing Then""   Es lo mismo que esto   ""' If b Is True Then  ""

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas