时间的计算 - 专家坐堂 - Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以下是引用采菊东篱下在2019/6/20 23:09:00的发言：
7点到8点之间的打卡全部安8点计，晚上20时到20.30分之间的时间安20时计，那么你表上计算出来的数很多多了0.5，不对了。

[此贴子已经被作者于2019/6/21 7:11:54编辑过]

你判断一下d1、d2的值啊，比如，如果是7-8点的，把d1改成8点。

Select Case e.DataCol.name
    Case "时间1","时间2","时间3","时间4","时间5","时间6"
        Dim d1 As Date = e.DataRow("时间1")
        Dim d2 As Date = e.DataRow("时间2")
        Dim d3 As Date = e.DataRow("时间3")
        Dim d4 As Date = e.DataRow("时间4")
        If d2 = Nothing Then
            Dim fdr = e.DataTable.Find("_Identify > " & e.DataRow("_Identify"))
            If fdr IsNot Nothing Then
                d2 = fdr("时间1")
            Else
                d2 = d1
            End If
        ElseIf d1.hour <= 5 Then
            If d3 <> Nothing Then
                d1 = d2
                d2 = d3
            Else
                Dim fdr = e.DataTable.Find("_Identify > " & e.DataRow("_Identify"))
                If fdr IsNot Nothing Then
                    d1 = e.DataRow("时间2")
                    d2 = fdr("时间1")
                Else
                    d2 = d1
                End If
            End If
        End If
        Dim d As Date = #07:00#
        Dim d0 As Date = #08:00#
        Dim d5 As Date = #20:00#
        Dim d6 As Date = #20:30#
        If d < d1 And d1 < d0 Then
            d1 = d0
        End If
        If d5 < d2 And d2 < d6 Then
            d2 = d5
        End If
        If d5 < d3 And d3 < d6 Then
            d3 = d5
        End If

        Dim sp As TimeSpan = d2-d1
        Dim n1 = sp.TotalHours
        Dim n = Math.Floor(n1)
        If n1 > n+0.5 Then
            n1 = n+0.5
        End If
        e.DataRow("工作时间") = iif(n1>24, 0, n1)
End Select

这段代码始终没起作用！

Dim d As Date = #07:00#
        Dim d0 As Date = #08:00#
        Dim d5 As Date = #20:00#
        Dim d6 As Date = #20:30#
        If d < d1 And d1 < d0 Then
            d1 = d0
        End If
        If d5 < d2 And d2 < d6 Then
            d2 = d5
        End If
        If d5 < d3 And d3 < d6 Then
            d3 = d5
        End If

7点到8点，20点到20点30分这段时间他们的工作时间应是12小时，没有小数，可程序计算出来有的还会多出半小时。
图片点击可在新窗口打开查看

此主题相关图片如下：qq图片20190621232857.png

Dim d As String = "07:00"

Dim d0 As String = "08:00"

Dim d5 As String = "20:00"

Dim d6 As String = "20:30"

If d < Format(d1,"HH:mm") And Format(d1,"HH:mm") < d0 Then

d1 = Format(d1,"yyyy-MM-dd ") & d0

End If

If d5 < Format(d2,"HH:mm") And Format(d2,"HH:mm") < d6 Then

d2 = Format(d1,"yyyy-MM-dd ") & d5

End If

If d5 < Format(d3,"HH:mm") And Format(d3,"HH:mm") < d6 Then

d3 = Format(d1,"yyyy-MM-dd ") & d5

End If

密码：732100

此主题相关图片如下：qq图片20190623160220.png

我换了一组打卡数，出现负数，如图：

下载信息 [文件大小：下载次数： ]
点击浏览该文件:管理项目2.zip

[此贴子已经被作者于2019/6/23 16:28:17编辑过]

第14行的算法应是第15行的时间1减第14行的时间2，如此类推，直至下一个奇打卡次数，这是夜班的算法，夜班不受7点到8点安8点计，20点到20点30分安20时计限。

[此贴子已经被作者于2019/6/23 16:27:05编辑过]

Select Case e.DataCol.name
    Case "时间1","时间2","时间3","时间4","时间5","时间6"
        Dim d1 As Date = e.DataRow("时间1")
        Dim d2 As Date = e.DataRow("时间2")
        Dim d3 As Date = e.DataRow("时间3")
        Dim d4 As Date = e.DataRow("时间4")
        If d2 = Nothing Then
            Dim fdr = e.DataTable.Find("时间1 > #" & e.DataRow("时间1") & "# and 工号='" & e.DataRow("工号") & "'", "时间1")
            If fdr IsNot Nothing Then
                d2 = fdr("时间1")
            Else
                d2 = d1
            End If
        ElseIf d1.hour <= 5 Then
            If d3 <> Nothing Then
                d1 = d2
                d2 = d3
            Else
                Dim fdr = e.DataTable.Find("时间1 > #" & e.DataRow("时间1") & "# and 工号='" & e.DataRow("工号") & "'", "时间1")
                If fdr IsNot Nothing Then
                    d1 = e.DataRow("时间2")
                    d2 = fdr("时间1")
                Else
                    d2 = d1
                End If
            End If
        End If
        Dim d As String = "07:00"
        Dim d0 As String = "08:00"
        Dim d5 As String = "20:00"
        Dim d6 As String = "20:30"

        If d < Format(d1,"HH:mm") And Format(d1,"HH:mm") < d0 Then
            d1 = Format(d1,"yyyy-MM-dd ") & d0
        End If
        If d5 < Format(d2,"HH:mm") And Format(d2,"HH:mm") < d6 Then
            d2 = Format(d2,"yyyy-MM-dd ") & d5
        End If
        If d5 < Format(d3,"HH:mm") And Format(d3,"HH:mm") < d6 Then
            d3 = Format(d3,"yyyy-MM-dd ") & d5
        End If
        Dim sp As TimeSpan = d2-d1
        Dim n1 = sp.TotalHours
        Dim n = Math.Floor(n1)
        If n1 > n+0.5 Then
            n1 = n+0.5
        End If
        e.DataRow("工作时间") = iif(n1>28, 0, n1)
End Select
If e.DataRow("工作时间") > 12
    Dim sp1 As Double =e.DataRow("工作时间") -12
    Dim n2 = Math.Floor(sp1)
    If sp1 > n2+0.5 Then
        sp1 = n2+0.5
    Else
        sp1 = n2
    End If
    e.DataRow("加班时间") = sp1
End If

此主题相关图片如下：qq图片20190623201146.png

密码732100

我做在窗口的按钮程序有问题：

Dim dr2 As DataRow

For Each dr1 As DataRow In DataTables("打卡数据").DataRows

dr2 = DataTables("考勤统计").AddNew()

If dr1("已整理") = True

e.Cancel = True '如果是,取消操作.

Else

Dim p As Date = Nothing

Dim i As Integer = 1

For Each dc As DataCol In DataTables("打卡数据").DataCols

If dc.Name Like "时间*" AndAlso dc.name <> "刷卡日期" Then

If dr1.IsNull(dc.name) = False Then

Dim sp As TimeSpan = CDate(dr1(dc.name)) - p

If sp.TotalMinutes > 5 Then

dr2("时间" & i) = dr2("刷卡日期") & " " & dr1(dc.Name)

i += 1

p = dr1(dc.Name)

End If

Else

dr2(dc.name) = dr1(dc.name)

dr1("已整理") = True

End If

e.Form.Controls("Button1").Enabled = False

虽然取消了复制，但产生了空行，如何让空行不产生。

另外，表属性上的程序还是有问题：

有负数产生。

下载信息 [文件大小：下载次数： ]
点击浏览该文件:管理项目2.zip

比如

For Each dr1 As DataRow In DataTables("打卡数据").DataRows

'dr2 = DataTables("考勤统计").AddNew()

If dr1("已整理") = True

e.Cancel = True '如果是,取消操作.

Else

Dim p As Date = Nothing

dr2 = DataTables("考勤统计").AddNew()

主题：时间的计算