当前位置：首页 → 问答吧 → 如何将其他表中的内容提取到汇总表中。

如何将其他表中的内容提取到汇总表中。

时间：2011-08-06

来源：互联网

想通过使用一个代码，一次性现在有3个分表中的内容，提取（复制）到汇总表，形成汇总。

附件

新建文件夹.rar(17.23 KB)

2011-8-6 11:08, 下载次数: 10

作者: fd_jhl 发布时间: 2011-08-06

可以是可以，不过你3个文件要打开的才能更新很麻烦
你做的东西和我之前的很像，为什么不把三个文件作为子文件和汇总放一起呢？

作者: Principe82 发布时间: 2011-08-06

汇总问题，请先在论坛里搜索一下。。。

作者: jiminyanyan 发布时间: 2011-08-06

因为不是一个人做的，目的是汇总。

作者: fd_jhl 发布时间: 2011-08-06

复制内容到剪贴板

代码:

Sub zdgx()
Dim Arr, myPath$, myName$, sh As Worksheet
Dim m&, funm$, n&, Sht As Worksheet
Dim d, k, t, Brr
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
funm = "汇总表.xls"
Set Sht = ActiveSheet
Sht.[a2:c1000].ClearContents
Sht.[a2:c1000].Borders.LineStyle = xlNone
myPath = ThisWorkbook.Path & "\"
myName = Dir(myPath & "*.xls")
n = 2
Do While myName <> "" And myName <> funm
      With GetObject(myPath & myName)
         Set sh = .Sheets("Sheet1")
         m = sh.[a65536].End(xlUp).Row
         Arr = sh.Range("a2:c" & m)
         For i = 1 To UBound(Arr)
            x = Arr(i, 1) & "|" & Arr(i, 2)
            d(x) = d(x) + Arr(i, 3)
         Next
         .Close False
      End With
      myName = Dir
Loop
k = d.keys
t = d.items
ReDim Brr(1 To d.Count, 1 To 3)
For i = 0 To UBound(k)
      Brr(i + 1, 1) = Split(k(i), "|")(0)
      Brr(i + 1, 2) = Split(k(i), "|")(1)
      Brr(i + 1, 3) = t(i)
Next
Sht.Range("a2").Resize(d.Count, 3) = Brr
Sht.Range("a1:c" & d.Count + 1).Borders.LineStyle = 1
Set d = Nothing
Application.ScreenUpdating = True
End Sub

作者: 蓝桥玄霜发布时间: 2011-08-06

请见附件。