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
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 SubSi 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 ""
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).