求老师考勤表年度汇总计算代码

gglili

quqiyuan 发表于 2025-3-17 14:48
另外写了代码汇总，仅供参考。。。

老师，怎样才能仅计算至汇总行的上一行，且在汇总行对应的R列单元格对以上数据时行汇总

quqiyuan

gglili 发表于 2025-3-17 15:30
老师，怎样才能仅计算至汇总行的上一行，且在汇总行对应的R列单元格对以上数据时行汇总

本来就是嘛，怎么会？除非汇总行下面还有数据。

gglili

quqiyuan 发表于 2025-3-17 15:42
本来就是嘛，怎么公？

老师，我把年度汇总表原来的数据删除后，点击“提取汇总”，再在C列填写工日单价，点击“按钮1”。就会出现越过总计行，往下计算的情况

quqiyuan

gglili 发表于 2025-3-17 15:51
老师，我把年度汇总表原来的数据删除后，点击“提取汇总”，再在C列填写工日单价，点击“按钮1”。就会出 ...

我的附件测试正常啊！应该是汇总行下面有数据，用了usedrange, 就引用了下面数据了。等下回去再改一下，定位一下合计单元格，这样准确点。

gglili

quqiyuan 发表于 2025-3-17 16:28
我的附件测试正常啊！应该是汇总行下面有数据，用了usedrange, 就引用了下面数据了。等下回去再改一下， ...

谢谢老师，麻烦您了

quqiyuan

gglili 发表于 2025-3-17 16:52
谢谢老师，麻烦您了

稍稍改动了下，你测试一下。。。

quqiyuan

代码如下。。。
Sub test1()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    t = Timer
    Dim wb As Workbook, sht As Worksheet, sh As Worksheet
    Set wb = ThisWorkbook
    p = wb.Path & "\"
    Set sht = wb.Sheets("考勤表")
    Set Rng = sht.Columns(1).Find("总计")
    Set Rng = sht.[a1].Resize(Rng.Row, 18)
    arr = Rng.Value
    ReDim brr(1 To UBound(arr) - 4, 0)
    For i = 4 To UBound(arr) - 1 Step 2
        Sum = 0
        If arr(i, 3) <> Empty Then
            For j = 5 To 16
                If arr(i + 1, j) <> Empty Then
                    Sum = Sum + arr(i, j) * arr(i + 1, j)
                Else
                    Sum = Sum + arr(i, 3) * arr(i, j)
                End If
            Next
        Else
            For j = 5 To 16
                If arr(i + 1, j) <> Empty Then
                    Sum = Sum + arr(i, j) * arr(i + 1, j)
                End If
            Next
        End If
        brr(i - 3, 0) = Sum
    Next
    With sht
        .[r4].Resize(UBound(brr)) = brr
        .Cells(UBound(arr), UBound(arr, 2)) = "=sum(r4c:r[-1]c)"
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "共耗时：" & Format(Timer - t, "0.0000") & " 秒！！！", 64
End Sub
   

gglili

quqiyuan 发表于 2025-3-17 18:33
稍稍改动了下，你测试一下。。。

老师，运行后出现这个

quqiyuan

gglili 发表于 2025-3-17 18:47
老师，运行后出现这个

搞不清楚你什么情况，再换个方法。。。

quqiyuan

代码如下。。。
Sub test1()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    t = Timer
    Dim wb As Workbook, sht As Worksheet, sh As Worksheet
    Set wb = ThisWorkbook
    p = wb.Path & "\"
    Set sht = wb.Sheets("考勤表")
'    Set Rng = sht.Columns(1).Find("总计")
    r = sht.Cells(Rows.Count, 1).End(3).Row
    Set Rng = sht.[a1].Resize(r, 18)
    arr = Rng.Value
    ReDim brr(1 To UBound(arr) - 4, 0)
    For i = 4 To UBound(arr) - 1 Step 2
        Sum = 0
        If arr(i, 3) <> Empty Then
            For j = 5 To 16
                If arr(i + 1, j) <> Empty Then
                    Sum = Sum + arr(i, j) * arr(i + 1, j)
                Else
                    Sum = Sum + arr(i, 3) * arr(i, j)
                End If
            Next
        Else
            For j = 5 To 16
                If arr(i + 1, j) <> Empty Then
                    Sum = Sum + arr(i, j) * arr(i + 1, j)
                End If
            Next
        End If
        brr(i - 3, 0) = Sum
    Next
    With sht
        .[r4].Resize(UBound(brr)) = brr
        .Cells(UBound(arr), UBound(arr, 2)) = "=sum(r4c:r[-1]c)"
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "共耗时：" & Format(Timer - t, "0.0000") & " 秒！！！", 64
End Sub