Código de selección de datos por fecha no funciona
Saludos, solicito su ayuda ya que no estoy muy ducho con excel vb.... Tengo en la hoja 1 de excel una serie de datos almacenados; en la columna "B" se almacenan fechas y en la columna "C" se almacena el tipo de movimiento. Debo seleccionar de dicha hoja y pegar en otra, ciertos datos de aquellas filas que cumplan el criterio de que su fecha sea igual a una fecha establecida en la celda "O1" y que el tipo de movimiento sea igual al indicado en el código. Ahora bien, en el código de vb excel 2007 que estoy usando me hace la selección y copiado de los datos pero cumpliendo solo la condición del tipo de movimiento y no me toma en cuenta el de la fecha... ¿En donde esta el error?...
Este es el código que estoy usando:
Function ComparaFechas(ByVal Fecha1 As Date, Fecha2 As Date) As Boolean
If FormatDateTime(Fecha1, vbShortDate) = FormatDateTime(Fecha2, vbShortDate) Then
ComparaFechas = True
Else
ComparaFechas = False
End If
End Function
Sub exporta()
Application.ScreenUpdating = False
On Error Resume Next
Dim filaex, filaim, conta As Integer
Dim Fecha1, Fecha2 As Date
filaex = 6
filaim = 2
conta = 0
Fecha1 = Range("B6:B5000").Value ' rango con las fechas que se quieren comparar
Fecha2 = Range("O1").Value
While Sheets("Registro").Cells(filaex, 1) <> Empty
If ComparaFechas(Fecha1, Fecha2) = True Then
If Sheets("Registro").Cells(filaex, 3) = "Ingreso" Then
Sheets("Resumen").Cells(filaim, 1) = Sheets("Registro").Cells(filaex, 4)
Sheets("Resumen").Cells(filaim, 2) = Sheets("Registro").Cells(filaex, 5)
Sheets("Resumen").Cells(filaim, 3) = Sheets("Registro").Cells(filaex, 6)
Sheets("Resumen").Cells(filaim, 4) = Sheets("Registro").Cells(filaex, 7)
Sheets("Resumen").Cells(filaim, 5) = Sheets("Registro").Cells(filaex, 8)
Sheets("Resumen").Cells(filaim, 6) = Sheets("Registro").Cells(filaex, 9)
Sheets("Resumen").Cells(filaim, 7) = Sheets("Registro").Cells(filaex, 10)
Sheets("Resumen").Cells(filaim, 8) = Sheets("Registro").Cells(filaex, 11)
Sheets("Resumen").Cells(filaim, 9) = Sheets("Registro").Cells(filaex, 12)
Sheets("Resumen").Cells(filaim, 10) = Sheets("Registro").Cells(filaex, 13)
conta = conta + 1
filaim = filaim + 1
End If
End If
filaex = filaex + 1
Wend
MsgBox (" Se registraron con exito " & conta & " Transacciones de Ingreso"), vbInformation
Application.ScreenUpdating = False
End Sub
Al ejecutarlo me copia en la hoja "Resumen", todas las filas encontradas de "ingreso" sin importar la fecha que se coloque en "O1"... De antemano....Gracias
1 Respuesta
Veo dos problemas en el código... todo relacionado con
Fecha1 = Range("B6:B5000").Value
Primero
Range("B6:B5000").Value.... no es un rango que especifique si los valores los vas a obtener de Registro o de Resumen... pues dependiendo de en que hoja ejecutes el código va a tomarlos de una o de otra... le falta el Sheets("Registro"). por delante...
Pero si la ejecutas en la Hoja Registro... ok igual funciona...
Segundo y aquí es que radica el problema
Fecha1 esta dimensionado como Fecha... lo cual es correcto
por al asignar Fecha1 = Range("B6:B5000").Value estas intentado asignar TODOS los valores de lo que es una MATRIZ a una variable de UN solo valor....
me parece que deberías cambiarlo por Fecha1 = Sheets("Registro"). Cells(filaex, 2) para que vaya tomando los valores 1 a 1... y ademas colocarldo dentro del loop While... no antes para que se vaya actualizando
en resumen... cambiar
contá = 0
Fecha1 = Range("B6:B5000").Value ' rango con las fechas que se quieren comparar
Fecha2 = Range("O1").Value
While Sheets("Registro").Cells(filaex, 1) <> Empty
If ComparaFechas(Fecha1, Fecha2) = True Then
If Sheets("Registro").Cells(filaex, 3) = "Ingreso" Then
por
conta = 0
Fecha2 = Range("O1").Value
While Sheets("Registro").Cells(filaex, 1) <> Empty
Fecha1 = Sheets("Registro").Cells(filaex, 2) ' FILA CAMBIADA
If ComparaFechas(Fecha1, Fecha2) = True Then
If Sheets("Registro").Cells(filaex, 3) = "Ingreso" Then
Finalmente... 2 observaciones...
1) Me parece que al ser definidas las variables como Date no era necesario FormatDateTime
2) Creo que era más fácil que el código usar simplemente un filtro personalizado avanzado! :)
Me comentas como te fue
Agradezco su pronta respuesta y disculpe mi tardanza; realice los cambios y el código funciono de maravilla, y lo que es mejor, que entendí la solucion. Se que la utilizacion de un filtro avanzado hubiese sido la solucion perfecta, pero no me hubiese permitido practicar con vb, el asunto es que estoy tomando un curso online y trato de practicar con casos reales... Agradezco su asistencia y pienso que no serà la ultima... Gracias
