excel 多表汇总请教

chenkj0802

老师，我这边有张培训的统计表，是每一期参加的人员和工号。
现在要把每一期的参加人员统计汇总到第一个sheet中，第三列会有视频和空白，空白的按照2.5显示在sheet1中，视频按照1显示。
这样可以用vba实现嘛，后面还会有很多同格式的sheet添加进去。
麻烦各位老师帮忙看看

yaozong

1. Sub test()
   
2. Sheets("汇总").Activate
   
3. Dim d, sh As Worksheet, arr, brr(1 To 1000, 1 To 100), i&, m&, n&, s$, w
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. m = 1: n = 2
   
6. brr(1, 1) = "工号": brr(1, 2) = "姓名"
   
7. For Each sh In Worksheets
   
8.   If sh.Name <> "汇总" Then
   
9.     n = n + 1
   
10.     brr(1, n) = sh.Name
    
11.     arr = sh.Range("c1", sh.[a65536].End(3)).Value
    
12.     For i = 2 To UBound(arr)
    
13.       s = arr(i, 1) & arr(i, 2)
    
14.       w = IIf(arr(i, 3) = "视频", 1, 2.5)
    
15.       If Not d.exists(s) Then
    
16.         m = m + 1
    
17.         d(s) = m
    
18.         brr(m, 1) = arr(i, 1)
    
19.         brr(m, 2) = arr(i, 2)
    
20.         brr(m, n) = w
    
21.       Else
    
22.         brr(d(s), n) = w
    
23.       End If
    
24.     Next
    
25.   End If
    
26. Next
    
27. [g1].Resize(m, n) = brr
    
28. End Sub

复制代码

chenkj0802

yaozong 发表于 2019-3-24 12:05

太感谢了，完美实现

jiminyanyan

做个记号。。。

jjmysjg

yaozong 发表于 2019-3-24 12:05

yaozong老师你好!
不转换，只想把各个分表的数据汇总到总表，不转换成1或2.5，怎么修改代码
谢谢

jiminyanyan

jjmysjg 发表于 2019-3-24 21:51
yaozong老师你好!
不转换，只想把各个分表的数据汇总到总表，不转换成1或2.5，怎么修改代码
谢谢

这样么
Sub test1() '多工作薄汇总
    Sheets("汇总").Activate
    Dim d, sh As Worksheet, arr, brr(1 To 1000, 1 To 100), i&, m&, n&, s$, w
    Set d = CreateObject("Scripting.Dictionary")
    m = 1: n = 2
    brr(1, 1) = "工号": brr(1, 2) = "姓名"
    For Each sh In Worksheets
        If sh.Name <> "汇总" Then
            n = n + 1
            brr(1, n) = sh.Name  '第3列起
            arr = sh.Range("c1", sh.[a65536].End(3)).Value
            For i = 2 To UBound(arr)
                s = arr(i, 1) & arr(i, 2)
                If Not d.exists(s) Then
                    m = m + 1
                    d(s) = m
                    brr(m, 1) = arr(i, 1)
                    brr(m, 2) = arr(i, 2)
                    brr(m, n) = arr(i, 3)
                Else
                    brr(d(s), n) = arr(i, 3)
                End If
            Next
        End If
    Next
    [g1].Resize(m, n) = brr
End Sub

jjmysjg

yaozong 发表于 2019-3-24 12:05

yaozong老师你好：
文件夹内的工作簿，能按这个代码汇总吗
谢谢

jjmysjg

jiminyanyan 发表于 2019-3-24 21:58
这样么
Sub test1() '多工作薄汇总
    Sheets("汇总").Activate

麻烦大侠看看

yaozong

jjmysjg 发表于 2019-3-26 21:34
yaozong老师你好：
文件夹内的工作簿，能按这个代码汇总吗
谢谢

这不难，现在没空，晚上帮你做。