1234

ExcelHome技术论坛

用户名  找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

帖子
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 285|回复: 10

课时量整月汇总

[复制链接]

TA的精华主题

TA的得分主题

发表于 2024-11-19 15:30 | 显示全部楼层 |阅读模式
一个月每天表格格式一样,能用vba对每天课时量汇总到“整月汇总”工作表中去吗?

vba对一个月课时一键汇总到整月汇总.zip

975.07 KB, 下载次数: 12

TA的精华主题

TA的得分主题

发表于 2024-11-19 16:02 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
原来的模块里,for aa =7 to sheet.count
sheets("功能表").[ad3] 改 汇总表.[a3]

TA的精华主题

TA的得分主题

发表于 2024-11-19 16:10 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-11-19 16:33 来自手机 | 显示全部楼层
mjm04 发表于 2024-11-19 16:10
WPS 没有VBA啊

不会吧,可以兼容的

TA的精华主题

TA的得分主题

发表于 2024-11-19 16:34 | 显示全部楼层
我看这个也不用vba把,直接sum求和就出来了,排列完全一致的

image.png

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-11-19 16:38 来自手机 | 显示全部楼层
因为每个月的每天工作表都是由VBA新建的,你用公式求和后公式全部时效

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-11-19 17:57 | 显示全部楼层
shiruiqiang 发表于 2024-11-19 16:02
原来的模块里,for aa =7 to sheet.count
sheets("功能表").[ad3] 改 汇总表.[a3]

在哪里,头罩混了也没找到

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-11-19 17:59 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
shiruiqiang 发表于 2024-11-19 16:02
原来的模块里,for aa =7 to sheet.count
sheets("功能表").[ad3] 改 汇总表.[a3]

Sub 统计整月()

'Dim Sht As Worksheet
Dim arr, brr, crr, ar, br(1 To 100000, 1 To 20)
Dim dic
Dim d, d1, d2
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
Set dic = CreateObject("scripting.dictionary")

m = 2
For aa = 6 To Sheets.Count

        irow = Sheets(aa).Range("a65536").End(3).Row
        arr = Sheets(aa).Range("a1:n" & irow)
        arr(2, 3) = "早"
        For i = 3 To UBound(arr)
           For j = 3 To UBound(arr, 2)
           If Len(arr(i, j)) Then
              If Left(arr(i, j), 1) = 1 Then
                arr(i, j) = "高一"
              ElseIf Left(arr(i, j), 1) = 2 Then
                arr(i, j) = "高二"
              ElseIf Left(arr(i, j), 1) = 3 Then
                arr(i, j) = "高三"
              End If
           dic(arr(i, j) & "|" & arr(2, j)) = dic(arr(i, j) & "|" & arr(2, j)) + 1
           End If
           Next
        Next
        
        ar = Sheets(aa).Range("a1:n" & irow)

        For n = 4 To 11
        ar(2, n) = "课"
        Next
        For x = 3 To UBound(ar)
           If Not d1.exists(ar(x, 1) & "|" & ar(x, 2) & "|" & x) Then
           d1(ar(x, 1) & "|" & ar(x, 2) & "|" & x) = d1.Count + 1
           br(d1(ar(x, 1) & "|" & ar(x, 2) & "|" & x), 1) = ar(x, 1)
           br(d1(ar(x, 1) & "|" & ar(x, 2) & "|" & x), 2) = ar(x, 2)
           End If

           For y = 3 To 14
           If Not d2.exists(ar(2, y)) Then
           m = m + 1
           d2(ar(2, y)) = m
           End If

           If Len(ar(x, y)) > 0 Then
            br(d1(ar(x, 1) & "|" & ar(x, 2) & "|" & x), d2(ar(2, y))) = br(d1(ar(x, 1) & "|" & ar(x, 2) & "|" & x), d2(ar(2, y))) + 1
           End If
           Next

        Next
        

Next
        
        Sheets("功能表").[q3:ai10000].ClearContents
        brr = Sheets("功能表").[p1].CurrentRegion
        For x = 3 To UBound(brr)
        For y = 2 To UBound(brr, 2)
        If dic.exists(brr(x, 1) & "|" & brr(2, y)) Then
        brr(x, y) = dic(brr(x, 1) & "|" & brr(2, y))
        End If
        Next
        Next
        Sheets("功能表").[p1].CurrentRegion = brr
        Sheets("功能表").[af2].Resize(1, d2.Count) = d2.keys
        Sheets("功能表").[ad3].Resize(d1.Count, UBound(br, 2)) = br
        MsgBox "当月数据已统计完成", 48, "提示:"


End Sub

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-11-19 18:02 | 显示全部楼层
本帖最后由 廖月 于 2024-11-19 18:04 编辑
shiruiqiang 发表于 2024-11-19 16:02
原来的模块里,for aa =7 to sheet.count
sheets("功能表").[ad3] 改 汇总表.[a3]

只找到了这一点,for aa =6 to sheet.count,也不是for aa =7 to sheet.count
啊,也没看到sheets("功能表").[ad3] ,愁死了
1732010459885.jpg

TA的精华主题

TA的得分主题

发表于 2024-11-19 18:19 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
-----------------------

对一个月课时一键汇总.rar

966.5 KB, 下载次数: 17

评分

1

查看全部评分

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

1234

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2025-2-18 19:41 , Processed in 0.026789 second(s), 12 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表