有大佬给做了下vba，想增加被引用sheet，或者汇总表sheet要怎么改。

lxhez

刚有个需求，有大佬给做了下vba，想咨询下，如果被引用sheet增加了，和汇总表不只这3个增加了，需要怎么改代码。


被引用数据有多个sheet表，为标黄sheet部分多个，可能比列示的更多，想分别整合到标红的sheet里，
需求举例：当多个被引用数据表中的T列为“供电”，且S列为“是”时，将被引用表组的T、U、V列，展示在供电汇总表的B、C、D列。E列需要展示行次数据的sheet表名称，A列展示对应的被引用数据表的序号。
当多个被引用数据表中的T列为“动”，且S列为“是”时，将被引用表组的T、U、V列，展示在动汇总表的B、C、D列。E列需要展示行次数据的sheet表名称，A列展示对应的被引用数据表的序号。
被引用数据的各表格会后续更新台账，想做到汇总表格自动随台账数据表更新而更新展示，


@清风竹-大佬给做的。 a结果汇总.zip (66.02 KB, 下载次数: 15)

2024-2-8 20:56 上传

点击文件名下载附件

ykcbf1100

还是让清风老师来改吧。

shiruiqiang

看了一下，清风竹老师就分为含有“汇总表”和不含“汇总表”的2种

3190496160

说明就没有认真测试看看呗
目前的代码应该是可以扩展的吧，目前的代码就是汇总不包含  汇总  二字的所有工作表的数据

lxhez

3190496160 发表于 2024-2-8 22:21
说明就没有认真测试看看呗
目前的代码应该是可以扩展的吧，目前的代码就是汇总不包含  汇总  二字的所有工 ...

哈哈，纯小白，在exel公式区问的，我现在才知道，那我应该懂怎么扩展了。谢谢

ahljkt

可随意增加sheet表，根据表名增加汇总表，即可实现汇总到相应的汇总表中。


Sub 汇总() '
    Dim sht As Worksheet
    Dim brr1(1 To 60000, 1 To 5)
    Dim sn()
   
    For si = 1 To Worksheets.Count '遍历工作表，将汇总表数量赋值给数组sn()
    If Worksheets(si).Name Like "*汇总表*" Then
    ReDim Preserve sn(si)
    sn(si) = Split(Worksheets(si).Name, "汇总表")(0)
    End If
    Next
   
    For Each sht In Worksheets '遍历工作表
      
       If sht.Name Like "*汇总表*" Then
         m = sht.Range("a65536").End(3).Row
         sht.Range("A2:e" & m + 2).ClearContents  '清空当前表数据"
       Else
          bm = sht.Name '工作表名称
          m = sht.Cells(65536, "s").End(3).Row
             If m < 3 Then m = 3
             arr = sht.Range("s3:v" & m) '汇总区域
             arr2 = sht.Range("a3:a" & m) '序号
         
          For ii = 1 To UBound(sn) '根据汇总表数循环
          For i = 1 To UBound(arr)
             If arr(i, 1) = "是" And arr(i, 2) = sn(ii) Then
                    n1 = n1 + 1
                    For j = 2 To UBound(arr, 2)
                       brr1(n1, j) = arr(i, j)
                    Next j
                    brr1(n1, 1) = arr2(i, 1)
                    brr1(n1, 5) = bm
             End If
          Next i
         
          r = Sheets(sn(ii) & "汇总表").Cells(Rows.Count, "A").End(xlUp).Row + 1
          If n1 <> 0 Then
          Sheets(sn(ii) & "汇总表").Range("A" & r).Resize(n1, 5) = brr1 '将变量赋值给对应表
          End If
          n1 = 0 '重新定义
          Erase brr1 '清空变量
         Next ii
      End If
   
    Next sht

End Sub

ahljkt

可随意增减工作表实现自动汇总，汇总表手动增加。

ahljkt

修改了代码，较上个代码提高运行速率。

ahljkt

Sub 汇总() '
    Dim sht As Worksheet
    Dim brr1(), sn()

    For si = 1 To Worksheets.Count '遍历工作表，将汇总表数量赋值给数组sn()
    If Worksheets(si).Name Like "*汇总表*" Then
    ReDim Preserve sn(si)
    sn(si) = Split(Worksheets(si).Name, "汇总表")(0)
    End If
    Next
   
    For Each sht In Worksheets '遍历工作表
        If sht.Name Like "*汇总表*" Then
            m = sht.Range("a65536").End(3).Row
            sht.Range("A2:e" & m + 2).ClearContents  '清空当前表数据"
        Else
            bm = sht.Name '工作表名称
            m = sht.Cells(65536, "s").End(3).Row
            ReDim brr1(1 To 5, 1 To m) '根据工作表使用区域采用转置法重新定义变量
            
            If m < 3 Then m = 3
            arr = sht.Range("s3:v" & m) '工作表汇总区域
            arr2 = sht.Range("a3:a" & m) '工作表序号
         
            For ii = 1 To UBound(sn) '根据汇总表数循环
                For i = 1 To UBound(arr) '工作表循环
                   If arr(i, 1) = "是" And arr(i, 2) = sn(ii) Then '工作表循环条件
                        n1 = n1 + 1
                            For j = 2 To UBound(arr, 2)
                            brr1(j, n1) = arr(i, j)
                            Next j
                        brr1(1, n1) = arr2(i, 1)
                        brr1(5, n1) = bm
                   End If
                Next i
         
            r = Sheets(sn(ii) & "汇总表").Cells(Rows.Count, "A").End(xlUp).Row + 1
            If n1 <> 0 Then
            Sheets(sn(ii) & "汇总表").Range("A" & r).Resize(n1, 5) = Application.WorksheetFunction.Transpose(brr1) '将变量赋值给对应表
            End If
            n1 = 0 '重新定义
            Next ii
      End If
    Next sht
End Sub

blackttea1

学习啦 ，谢谢