计算跨零点的时间时长，扣除几个时间段

zxsea_7426

看看是不是这样的

ping200030

zxsea_7426 发表于 2023-2-24 14:33
看看是不是这样的

是的，谢啦

ping200030

zxsea_7426 发表于 2023-2-24 14:33
看看是不是这样的

大佬，在考勤表汇总提取出现问题了，帮忙看看啊？

zxsea_7426

ping200030 发表于 2023-2-26 20:00
大佬，在考勤表汇总提取出现问题了，帮忙看看啊？

把代码中>0修改为<>""

ping200030

zxsea_7426 发表于 2023-2-26 21:23
把代码中>0修改为""

大佬，又遇到两个问题了
1、计算时长没问题了，但是为什么数据多了运行会那么慢呢？

2、重新计算时长时，原先的数据能先清空再计算吗？

zxsea_7426

ping200030 发表于 2023-2-27 08:48
大佬，又遇到两个问题了
1、计算时长没问题了，但是为什么数据多了运行会那么慢呢？

你的工作表中还保留了非常多的公式，所以非常慢，我打开文件就要花将近1分钟。
随机显示一个工作表，一个工作表便公式。能不慢吗？？

ping200030

zxsea_7426 发表于 2023-2-26 21:23
把代码中>0修改为""

大佬，有个新问题啊，帮忙搞个提取数据的代码呗？

zxsea_7426

Sub 出库明细表提取数据()
    Set d = CreateObject("scripting.dictionary")
    With Sheets("出库明细")
        r = .[a1048576].End(3).Row
        If r > 1 Then
            ar = Sheets("出库明细").[a2].CurrentRegion
        Else
            MsgBox "出库明细中无数据!"
            Exit Sub
        End If
    End With
    With Sheets("提取表")
        r = .[a1048576].End(3).Row
        If r > 2 Then .UsedRange.Offset(2).ClearContents
        col_ = .Cells(2, Columns.Count).End(1).Column
        ReDim br(1 To UBound(ar), 1 To col_)    '定义数组大小
        For j = 1 To col_
            If .Cells(2, j) <> "" Then d(.Cells(2, j).Value) = j
            br(1, j) = .Cells(2, j)
        Next j
        For j = 1 To UBound(ar, 2)
            If d.exists(ar(1, j)) Then
                l_ = d(ar(1, j))
                For i = 2 To UBound(ar)
                    br(i, l_) = ar(i, j)
                    br(i, 12) = "加工车间"
                Next i

            End If
        Next j
        Sheets("提取表").[a2].Resize(UBound(br), UBound(br, 2)) = br
    End With
End Sub

ping200030

zxsea_7426 发表于 2023-3-8 16:05
Sub 出库明细表提取数据()
    Set d = CreateObject("scripting.dictionary")
    With Sheets("出库明 ...

谢谢，还有个小问题：表头不动，从第4行开始直接提取数据，咋改下代码？

zxsea_7426

ping200030 发表于 2023-3-9 20:42
谢谢，还有个小问题：表头不动，从第4行开始直接提取数据，咋改下代码？

就是第2条记录和第三条记录不要呗,循环起始点修改为4,同时提取的记录号减少2条


Sub 出库明细表提取数据_2()
    Set d = CreateObject("scripting.dictionary")
    With Sheets("出库明细")
        r = .[a1048576].End(3).Row
        If r > 1 Then
            ar = Sheets("出库明细").[a2].CurrentRegion
        Else
            MsgBox "出库明细中无数据!"
            Exit Sub
        End If
    End With
    With Sheets("提取表")
        r = .[a1048576].End(3).Row
        If r > 2 Then .UsedRange.Offset(2).ClearContents
        col_ = .Cells(2, Columns.Count).End(1).Column
        ReDim br(1 To UBound(ar) - 2, 1 To col_)  '定义数组大小
        For j = 1 To col_
            If .Cells(2, j) <> "" Then d(.Cells(2, j).Value) = j
            br(1, j) = .Cells(2, j)
        Next j
        For j = 4 To UBound(ar, 2)
            If d.exists(ar(1, j)) Then
                l_ = d(ar(1, j))
                For i = 4 To UBound(ar)
                    br(i - 2, l_) = ar(i, j)
                    br(i - 2, 12) = "加工车间"
                Next i
            End If
        Next j
        Sheets("提取表").[a2].Resize(UBound(br), UBound(br, 2)) = br
    End With
End Sub