Como saber si fecha existe en columna
¿Hola Dan como estas?
Disculpa . Sabes que tengo un problema ! Tengo esta macro. Agrego el código!
Este busca en la columna D y si coincide muestra los datos en el listbox hasta ahí todo bien.
Pero mi pregunta es si puede agregar al código un mensaje que diga al no existir la fecha en la columna D "no se encontró la fecha".. El código esta en el evento change no se como hacer para que cuando termine de escribir la fecha en el textbox ejemplo 30/09/2018 que el código espere que termine de escribir los 10 dígitos ahí me diga que la fecha fecha no existe!
O que al estar el listbox en blanco muestre el mensaje no existe la fecha..
Por favor Dan
Private Sub txt_DTPicker1_Change()
lbltotal = ""
ListBox1.Clear
Dim fec As Date
ListBox1.ColumnCount = 8
ListBox1.ColumnWidths = "60;200;60;90;90;120;90;90"
For i = 2 To Hoja4.Range("A" & Rows.Count).End(xlUp).Row
fec = Format(Hoja4.Cells(i, "D"), "dd/mm/yyyy")
If fec = Txt_DTPicker1.Value Then
existe = False
If Hoja4.Cells(i, "G") > 0.0001 Then
For j = 0 To ListBox1.ListCount - 1
If IsNumeric(ListBox1.List(j)) Then vmate = CDbl(ListBox1.List(j)) Else vmate = ListBox1.List(j)
If IsNumeric(ListBox1.List(j, 3)) Then vlote = CDbl(ListBox1.List(j, 3)) Else vlote = ListBox1.List(j, 3)
'
If vmate = Hoja4.Cells(i, "A") And vlote = Hoja4.Cells(i, "B") Then
ListBox1.List(j, 6) = Format(CDbl(ListBox1.List(j, 6)) + Hoja4.Cells(i, "G"), "#,##0.000")
existe = True
Exit For
End If
Next
If existe = False Then agregar i, Hoja4
End If
End If
Next
End Sub
Private Sub ListBox1_Change()
On Error Resume Next
lbltotal = ""
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
valor = CDbl(Format(ListBox1.List(i, 6), "#,##0.000"))
valo2 = CDbl(Format(lbltotal, "#,##0.000"))
lbltotal = CDbl(valo2) + CDbl(valor)
lbltotal = (Format(lbltotal, "#,##0.000"))
End If
Next
End Sub
1 Respuesta
Respuesta de Dante Amor
1
Prueba con lo siguiente:
Private Sub txt_DTPicker1_Change()
lbltotal = ""
ListBox1.Clear
Dim fec As Date
If txt_DTPicker1 = "" Or Not IsDate(txt_DTPicker1) Or _
Len(txt_DTPicker1) < 10 Or Len(txt_DTPicker1) > 10 Then
Exit Sub
End If
ListBox1.ColumnCount = 8
ListBox1.ColumnWidths = "60;200;60;90;90;120;90;90"
For i = 2 To Hoja4.Range("A" & Rows.Count).End(xlUp).Row
fec = Format(Hoja4.Cells(i, "D"), "dd/mm/yyyy")
If fec = txt_DTPicker1.Value Then
existe = False
If Hoja4.Cells(i, "G") > 0.0001 Then
For j = 0 To ListBox1.ListCount - 1
If IsNumeric(ListBox1.List(j)) Then vmate = CDbl(ListBox1.List(j)) Else vmate = ListBox1.List(j)
If IsNumeric(ListBox1.List(j, 3)) Then vlote = CDbl(ListBox1.List(j, 3)) Else vlote = ListBox1.List(j, 3)
'
If vmate = Hoja4.Cells(i, "A") And vlote = Hoja4.Cells(i, "B") Then
ListBox1.List(j, 6) = Format(CDbl(ListBox1.List(j, 6)) + Hoja4.Cells(i, "G"), "#,##0.000")
existe = True
Exit For
End If
Next
If existe = False Then agregar i, Hoja4
End If
End If
Next
If ListBox1.ListCount = 0 Then
MsgBox "No hay registros que cumplan la condición"
End If
End Sub[sal u dos
.
