统计表格的vba如何编写，谢谢

chenxq9335

暑假快到了，计划在统计表做一个按钮，通过vba自动搜集报名汇总表的单位名称，并统计报名数据，谢谢！！

liulang0808

Sub 按钮2_Click()
    Set d = CreateObject("scripting.dictionary")
    arr = Sheets("报名汇总").UsedRange
    Call 删除数据行
    brr = Sheets("统计").[a1].Resize(UBound(arr), 7)
    r = 2
    For j = 3 To UBound(arr)
        If arr(j, 2) = "" Then arr(j, 2) = arr(j - 1, 2)
        If Not d.exists(arr(j, 2)) Then
            r = r + 1
            d(arr(j, 2)) = r
        End If
        x = d(arr(j, 2))
        brr(x, 1) = arr(j, 2)
        brr(x, 2) = brr(x, 2) + 1
        brr(x, 2 + arr(j, 5)) = brr(x, 2 + arr(j, 5)) + 1
        If arr(j, 4) = "男" Then
            brr(x, 6) = brr(x, 6) + 1
        Else
            brr(x, 7) = brr(x, 7) + 1
        End If
    Next j
    Sheets("统计").[a1].Resize(r, 7) = brr
End Sub

liulang0808

查询统计.zip (20.29 KB, 下载次数: 17)

2023-6-14 22:17 上传

点击文件名下载附件

gwjkkkkk

Sub test()
    Dim ar, vResult, i&, j&
    ar = Sheets("报名汇总").[A1].CurrentRegion
    ReDim vResult(1 To UBound(ar), 1 To 7)
    n = 1
    For i = 3 To UBound(ar)
        If Len(ar(i, 2)) Then
             r = r + 1
             vResult(r, 1) = ar(i, 2)
        End If
        vResult(r, 2) = vResult(r, 2) + 1
        For j = 3 To 5
            If ar(i, 5) = j - 2 Then vResult(r, j) = vResult(r, j) + 1: Exit For
        Next j
        If ar(i, 4) = "男" Then
            vResult(r, 6) = vResult(r, 6) + 1
        Else
            vResult(r, 7) = vResult(r, 7) + 1
        End If
    Next i
    [A3].Resize(r, 7) = vResult
End Sub

chenxq9335

liulang0808 发表于 2023-6-14 22:18

感谢老师，可以用，谢谢！！

chenxq9335

gwjkkkkk 发表于 2023-6-14 23:24
Sub test()
    Dim ar, vResult, i&, j&
    ar = Sheets("报名汇总").[A1].CurrentRegion

谢谢，学习学习，感谢

chenxq9335

计划在统计表在各老师的帮助下，能够完成统计任务，现在我自己添加了统计信息提示（总人数），再就是想继续优化：
1、统计-情况报告，统计后能后自动在统计数据下面添加各分项的合计。
2、为筛选各批次分表，报名汇总表我自己添加了拆离和合并键。一个想法，其实可以自动生成批次的分表（参考论坛老师们的码，还是不大懂）
只能求助，感谢感谢

chenxq9335

今天爬了一下论坛，学习了很多东西，分表问题可以解决，现在就不知道汇总后在表后计算合计咋办