Custom Search

Buscar entre fecha y fecha


La consulta de datos entre fecha y fecha es un tema muy consultado, aquí se agrega un ejemplo que crea un informe entre fechas seleccionadas, se agrega como aditamento tres bucles uno dentro de otro con luego de cumplir ciertos criterios suma las ventas correspondientes a cada cliente, en el link del final se podrá descargar el archivo de ejemplo, quizás también te interese ver una variante que consulta el saldo entre fecha y fecha .Te recomiendo que leas el post Funciones de fecha y hora y quizas te interese saber sobre formatos de fecha y hora.





Código que se inserta en botón de formulario 

Private Sub ComboBox1_AfterUpdate()
TextBox1 = CDate(Date - 30)
TextBox2 = CDate(Date)
End Sub

Private Sub CommandButton1_Click()
'Controla los datos ingresados en los cuadro de textbox1 sean fechas
Application.ScreenUpdating = False
'Controlo posibles errores
On Error Resume Next
If Not IsDate(TextBox1.Text) Then
MsgBox "fecha inválida"
TextBox1.SetFocus
Exit Sub
End If
'Valida fecha
Dim ubica1, ubica2 As String
Dim dia, mes As Integer
Dim año, fecha As Integer
'guardamos en variables el caracter encontrado en la posición 3 y 6
ubica1 = Mid(TextBox1.Text, 3, 1)
ubica2 = Mid(TextBox1.Text, 6, 1)
'comparamos si se trata de '/'
If ubica1 <> "/" Or ubica2 <> "/" Then
MsgBox ("Debes ingresar datos con este formato: dd/mm/aa")
TextBox1.SetFocus
Exit Sub
End If
dia = Mid(TextBox1.Value, 1, 2)
mes = Mid(TextBox1.Value, 4, 2)
año = Mid(TextBox1.Value, 7, 4)
fecha = Len(TextBox1)

'Controla lo ingresado, si no se cumple no es fecha y sale en msgbox
If dia > 31 Or mes > 12 Or año < 1900 Or fecha > 10 Then
MsgBox "Fecha incorrecta"
TextBox1.SetFocus
Exit Sub
End If

'Controla los datos ingresados en los cuadro de textbox2 sean fechas
If Not IsDate(TextBox2.Text) Then
MsgBox "fecha inválida"
TextBox2.SetFocus
Exit Sub
End If
'Valida fecha
Dim ubicatext1, ubicatext2 As String
Dim dia1, mes1 As Integer
Dim año1, fecha1 As Integer
'guardamos en variables el caracter encontrado en la posición 3 y 6
ubicatext2 = Mid(TextBox2.Text, 3, 1)
ubicatext2 = Mid(TextBox2.Text, 6, 1)
'comparamos si se trata de '/'
If ubicatext2 <> "/" Or ubicatext2 <> "/" Then
MsgBox ("Debes ingresar datos con este formato: dd/mm/aa")
TextBox2.SetFocus
Exit Sub
End If
dia1 = Mid(TextBox2.Value, 1, 2)
mes1 = Mid(TextBox2.Value, 4, 2)
año1 = Mid(TextBox2.Value, 7, 4)
fecha1 = Len(TextBox2)

'Controla lo ingresado, si no se cumple no es fecha y sale en msgbox
If dia1 > 31 Or mes1 > 12 Or año1 < 1900 Or fecha1 > 10 Then
MsgBox "Fecha incorrecta"
TextBox2.SetFocus
Exit Sub
End If
'Controla que la fecha final no sea menor a la inicial
Dim fechainicio As Date
Dim fechafinal As Date
fechainicio = TextBox1.Value
fechafinal = TextBox2.Value
If fechainicio > fechafinal Then
MsgBox "Fecha inválida"
TextBox2.SetFocus
Exit Sub
End If


'Muestra progressbar
Unload Me
ProgressForm.Show False
Dim R As Integer
Dim MT As Double
For R = 1 To 10
 MT = Timer
 ProgressForm.ProgressBar1.Max = 10
 Do
  Loop While Timer - MT < 0.05
   ProgressForm.ProgressBar1.Value = R
   ProgressForm.Label1.Caption = "Consultando datos......."
  
 DoEvents
Next R
Unload ProgressForm



' Busca los datos entre las fechas ingresadas
'quito protección de hoja si es que la tiene
'Sheets("listado op").Unprotect Password:="miclave"
'Dimensiono variables
Dim colinfo As Integer
Dim filainfo As Integer
Dim filavtas As Integer
Dim filavtas1 As Integer
Dim filanom As Integer
Dim filanom1 As Integer
Dim Acum, Tacum As Currency
Dim dato1 As Date
MASTERCARD PAYONEER

Dim dato2 As Date
Dim condi1  As Date
Dim condi2 As Date
Dim dato3 As String
Dim dato4 As String
Dim dato5 As String
Dim dato6 As String
colinfo = 2
filainfo = 3
filavtas = 2
filanom = 2
filanom1 = 2
filavtas1 = 2
cond1 = TextBox1.Value
cond2 = TextBox2.Value
Acum = 0
Tacum = 0
'Realiza bucle mientras no haya columnas vacias
 While Sheets("info").Cells(2, colinfo) <> Empty
 


  'Realiza un nuevo bucle mietras no haya filas vacias recorriendo la fila de vtas
    While Sheets("info").Cells(filainfo, 1) <> Empty
           
             While Sheets("vtas").Cells(filanom, 1) <> Empty
                    dato1 = Sheets("vtas").Cells(filavtas, 1).Value
                    dato2 = Sheets("vtas").Cells(filavtas, 1).Value
                    dato3 = Sheets("info").Cells(2, colinfo).Value
                    dato4 = Sheets("vtas").Cells(filanom, 6).Value
                    dato5 = Sheets("info").Cells(filainfo, 1).Value
                    dato6 = Sheets("vtas").Cells(filavtas, 7).Value
               
                    If dato1 >= cond1 And dato2 <= cond2 And dato3 = dato4 And dato5 = dato6 Then
                   
                            While Sheets("vtas").Cells(filavtas1, 1) <> Empty
                                   dato4 = Sheets("vtas").Cells(filanom1, 6).Value
                                   dato5 = Sheets("info").Cells(filainfo, 1).Value
                                   dato6 = Sheets("vtas").Cells(filavtas1, 7).Value
                                 
                                  If dato1 >= cond1 And dato2 <= cond2 And dato3 = dato4 And dato5 = dato6 Then
                                       Acum = Sheets("vtas").Cells(filavtas1, 9)
                                       Tacum = Tacum + Acum
                                       Sheets("info").Cells(filainfo, colinfo) = Tacum
                                      
                                  End If
                                 
                               filavtas1 = filavtas1 + 1
                               filanom1 = filanom1 + 1
                             Wend
                           
                    
                     End If
                Acum = 0
                Tacum = 0
                filavtas1 = 2
                filanom1 = 2
                filanom = filanom + 1
                filavtas = filavtas + 1
             Wend
     
      filavtas1 = 2
      filanom1 = 2
      filanom = 2
      filavtas = 2
      filainfo = filainfo + 1
     
      Wend
 filavtas1 = 2
 filanom1 = 2
 filanom = 2
 filavtas = 2
 filainfo = 3
 colinfo = colinfo + 1
 Wend

 'Cierro el formulario
 Unload Me
'Sheets("listado OP").Protect Password:="miclave"
'Devuelvo movimientos a la pantalla
Application.ScreenUpdating = True
End Sub
Private Sub Label3_Click()
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
TextBox2 = CDate(Date)
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub



Click para bajar archivo



Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.



If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.




Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends