请大神帮忙vba做一下餐费补贴的统计表格，以减轻工作量，谢谢！

烟火孤星泪

xbox1210 发表于 2024-9-8 11:35
参与一下..

请问是否可以更改为把所有数据批量都生成以下的形式，不再使用单个查询，一次性生成全部数据

quqiyuan

给你做成这样了，供你参考。。。

quqiyuan

代码如下。。。。
Sub allteacher()
    Application.EnableEvents = False
    arr = Sheet1.UsedRange
    Set d = CreateObject("scripting.dictionary")
    Set dic = CreateObject("scripting.dictionary")
    For i = 2 To UBound(arr)
        If Len(arr(i, 3)) <> 0 Then
            dic(arr(i, 3)) = ""
        End If
    Next
    ReDim brr(1 To UBound(arr), 1 To 10)
    For Each s In dic.keys
        x = 0
        For i = 2 To UBound(arr)
            If arr(i, 3) = s Then
                h = Split(arr(i, 5))
                If Not d.exists(s & "|" & h(0)) Then
                    x = x + 1
                    m = m + 1
                    brr(m, 1) = s
                    brr(m, 2) = arr(i, 4)
                    brr(m, 3) = h(0)
                    d(s & "|" & h(0)) = m
                End If
                n = d(s & "|" & h(0))
                Select Case Format(h(1), "hh:mm:ss")
                Case #6:30:00 AM# To #9:00:00 AM#
                    brr(n, 6) = brr(n, 6) + Val(arr(i, 6))
                    If brr(n, 6) > 5 Then
                        brr(n, 10) = 5
                    Else
                        brr(n, 10) = brr(n, 6)
                    End If
                Case #11:00:00 AM# To #1:00:00 PM#
                    brr(n, 5) = brr(n, 5) + Val(arr(i, 6))
                    If brr(n, 5) > 14 Then
                        brr(n, 9) = 14
                    Else
                        brr(n, 9) = brr(n, 5)
                    End If
                Case #5:00:00 PM# To #7:30:00 PM#
                    brr(n, 4) = brr(n, 4) + Val(arr(i, 6))
                    If brr(n, 4) > 10 Then
                        brr(n, 8) = 10
                    Else
                        brr(n, 8) = brr(n, 4)
                    End If
                End Select
                brr(n, 7) = "=sum(rc[-1]:rc[-3])"
            End If
        Next
        brr(n + 1, 9) = "共补贴"
        brr(n + 1, 10) = "=sum(r[-1]c:r[-" & x & "]c[-2])"
        m = n + 1
    Next
    Sheet2.UsedRange.Offset(2).Clear
    Sheet2.[a3].Resize(n + 1, 10) = brr
    Sheet2.[a3].Resize(n + 1, 10).Borders.LineStyle = 1
    Sheet2.UsedRange.Columns.AutoFit
    Sheet2.[b1] = Empty
    Beep
    Set d = Nothing
    Application.EnableEvents = True
End Sub

烟火孤星泪

quqiyuan 发表于 2024-9-9 13:34
给你做成这样了，供你参考。。。

每个教师的前面可否都加上A2：J10的标题行，然后空一格，再到下一个老师的数据

quqiyuan

烟火孤星泪 发表于 2024-9-9 14:19
每个教师的前面可否都加上A2：J10的标题行，然后空一格，再到下一个老师的数据

烟火孤星泪

quqiyuan 发表于 2024-9-9 14:57

录入了，提示for没有next

quqiyuan

烟火孤星泪 发表于 2024-9-9 15:09
录入了，提示for没有next

说明你没改对咯

xbox1210

下拉列表里加了个全部显示。

songshihai

songshihai 发表于 2024-9-8 13:39
咋回事?文字的没发上来???来个截图的试试,再发不上来就不发了

稍作修改,增加了单个查询和显示全部

lizhipei78

xbox1210 发表于 2024-9-9 18:41
下拉列表里加了个全部显示。

太厉害了，学习一下