Formulario con filtro en base a DNI y marcación de asistencia

[j.salas]

Buenos días amigos,

Tengo el siguiente problema con una Excel que estoy armando para el costeo de personal, resulta que en 2 formularios "frm_RegistroOpe" y "frm_RegistroOpeAdd" le inserté un filtro para que busque en las marcaciones de asistencia en base al DNI (Documento de identificación) y a la fecha de marcación, si no hay coincidencia entonces me lanza un mensaje diciendo que el personal no tiene marcación, pero no me está funcionando, ya probé todo tipo de código y no encuentro la solución, solamente llega a reconocer al primer dato de la tabla o al último, pero lo que yo necesito es que busque en toda la tabla, puse el siguiente código:

Private Sub CommandButton1_Click()
Dim Final As Long
Dim Fila As Long

Final = GetNuevoR(Hoja7)

        For Fila = 2 To Final
            If Hoja7.Cells(Fila, 2) Like ListBox1.List(ListBox1.ListIndex, 1) And Hoja7.Cells(Fila, 4) Like Me.lbl_Fecha.Caption Then
                With frm_RegistroOpe
                frm_RegistroOpe.txt_Cod = ListBox1.List(ListBox1.ListIndex)
                frm_RegistroOpe.txt_DNI = ListBox1.List(ListBox1.ListIndex, 1)
                frm_RegistroOpe.txt_Nombre = ListBox1.List(ListBox1.ListIndex, 2)
                frm_RegistroOpe.txt_Suelo = ListBox1.List(ListBox1.ListIndex, 3)
                frm_RegistroOpe.txt_Medida = "HR"
                Unload Me
                End With
                Exit Sub
            End If
        Next

    MsgBox ("Personal no tiene Marcación"), , "Fruit X Change"

End Sub

ese mismo código lo tengo insertado en el ListBox1 (Evento Doble Clic) y el CommandButton1 (Evento Clic) del formulario "frm_RegistroOpeAdd" y también lo inserté en el botón btn_Agregar (Evento clic) del formulario "frm_RegistroOpe". La fecha la obtiene del formulario "frm_Registro" por eso es que para ir probando le estoy poniendo la fecha manualmente en el objeto "lbl_fecha" de ambos formularios, este es el link del archivo Excel para que puedan revisarlo:

Costos RRHH

Espero puedan ayudarme, muchas gracias de ante mano

[Janlui]

En la Hoja Asistencia observa la Fila 2150 no tiene información y ahi aborta el Do While, pudiera ser este el problema.

Saludos.

[Antoni]

Sustituye tu procedimiento:

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim Fila As Long
On Error GoTo Salir
'--
For Fila = 2 To Hoja7.Range("A" & Rows.Count).End(xlUp).Row          '<-------------
   If Hoja7.Cells(Fila, 2) = ListBox1.List(ListBox1.ListIndex, 1) And _
      Hoja7.Cells(Fila, 4) = CDate(Me.lbl_Fecha.Caption) Then     '<-------------
      frm_RegistroOpe.txt_Cod = ListBox1.List(ListBox1.ListIndex)
      frm_RegistroOpe.txt_DNI = ListBox1.List(ListBox1.ListIndex, 1)
      frm_RegistroOpe.txt_Nombre = ListBox1.List(ListBox1.ListIndex, 2)
      frm_RegistroOpe.txt_Suelo = ListBox1.List(ListBox1.ListIndex, 3)
      Unload Me
      Exit Sub
   End If
Next
MsgBox ("Personal no tiene Marcación"), , "Fruit X Change"
'--
Salir:
   If Err <> 0 Then
      MsgBox "Debe Seleccionar un item", vbExclamation, "Fruit X Change"
   End If
End Sub

 

[j.salas]

Hace 6 horas, Antoni dijo:

Sustituye tu procedimiento:

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim Fila As Long
On Error GoTo Salir
'--
For Fila = 2 To Hoja7.Range("A" & Rows.Count).End(xlUp).Row          '<-------------
   If Hoja7.Cells(Fila, 2) = ListBox1.List(ListBox1.ListIndex, 1) And _
      Hoja7.Cells(Fila, 4) = CDate(Me.lbl_Fecha.Caption) Then     '<-------------
      frm_RegistroOpe.txt_Cod = ListBox1.List(ListBox1.ListIndex)
      frm_RegistroOpe.txt_DNI = ListBox1.List(ListBox1.ListIndex, 1)
      frm_RegistroOpe.txt_Nombre = ListBox1.List(ListBox1.ListIndex, 2)
      frm_RegistroOpe.txt_Suelo = ListBox1.List(ListBox1.ListIndex, 3)
      Unload Me
      Exit Sub
   End If
Next
MsgBox ("Personal no tiene Marcación"), , "Fruit X Change"
'--
Salir:
   If Err <> 0 Then
      MsgBox "Debe Seleccionar un item", vbExclamation, "Fruit X Change"
   End If
End Sub

 

Esa solución me ayudó bastante, muchas gracias, con eso ya pude solucionar el problema