新手，求大神帮助，多个sheet表的数据提取到一张汇总表中

summer201401 · 发表于 2015-3-11 11:22

见附件，多个sheet表（绩效表格），最终要提取几个固定位置的数据到最后的汇总表中，如何做,求帮助。

officer performance draft V2 - 副本.7z (34.63 KB, 下载次数: 73)

TomingTang · 发表于 2015-3-11 11:54

Sub 汇总()
Dim Arr(1 To 100, 1 To 12), i%, j%, drow%, k%, ddrow%
i = 1
Dim sht As Worksheet '定义sht 为工作表
' Worksheets("汇总表").Range("a2:p65536").ClearContents
For Each sht In Worksheets
' With sht
' MsgBox sht.Name
If sht.Name <> "汇总表" Then
With sht
' drow = sht.Range("a65536").End(xlUp).Row
Arr(i, 2) = .Range("d4"): Arr(i, 3) = .Range("n4"): Arr(i, 4) = .Range("d5")
Arr(i, 5) = .Range("d6"): Arr(i, 7) = .Range("q19"): Arr(i, 8) = .Range("q31")
Arr(i, 9) = .Range("q43"): Arr(i, 10) = .Range("q55"): Arr(i, 11) = .Range("q67")
Arr(i, 12) = .Range("q72")
Arr(i, 1) = i
i = i + 1
End With
' ddrow = Worksheets("汇总").Range("a65531").End(xlUp).Row + 1
' MsgBox ddrow
End If
' End With
Next
Worksheets("汇总表").Range("a" & Worksheets("汇总表").Range("b65536").End(3).Row + 1).Resize(UBound(Arr, 1), UBound(Arr, 2)) = Arr
End Sub

复制代码

TomingTang · 发表于 2015-3-11 11:55

请查看附件。
没有模拟结果，不知道有没有弄错。以后最后把模拟结果也弄上一个。

summer201401 · 发表于 2015-3-13 09:19

非常感谢，我去测试一下

summer201401 · 发表于 2015-3-13 10:24

TomingTang 发表于 2015-3-11 11:55
请查看附件。
没有模拟结果，不知道有没有弄错。以后最后把模拟结果也弄上一个。

测试了一下，很好用，还有个问题：
1.如果以后，在汇总表里需要增加提取内容，我应该怎么改这个代码呢？请原谅，我现在VB连入门还没开始呢。
2.我如果有很多人的这个表格，当然格式都是一样的，我只需要把她们的sheet表插入到这个工作簿里就可以了是吗？
3.当前边的SHEET表格中的数据有变化时，后边的汇总表中，是实时更新的吗？我应该怎么做？我发现，当我重复点击两次宏按钮的时候，所有的数据是重新在原有数据下边再次提取，而不是更新。

TomingTang · 发表于 2015-3-13 14:33

1、11-16行哪里增加代码，增加需要汇总的项
2、插入到这个工作簿就可以了。
3、是需要你点击代码运行。代码会把汇总数据加到汇总表下面。
如果想不重复，就把汇总表数据删除，再运行。或者我调整一下代码。

summer201401 · 发表于 2015-3-13 14:58

对于第二个问题，我最多可以插入多少个sheet表呢？是100吗？
对于第三个问题，比较奇怪，附件中是我点了3次的结果，而我不希望是这样的。但奇怪的是，你开始给我的代码在运行的时候，得到的结果不是这样的。而是在原有的1.2.3.4行处更新数据，但我不清楚是我做了什么操作，就变成了现在这样子，我比较了这两种代码，没有发现区别。

PS，我学习了你的代码，也发现了是在11-16行处增加内容。但没看懂，是哪一处代码的设置，让更新的数据是在汇总表里的第四行开始更新，请教？

officer performance draft V3.zip (51.04 KB, 下载次数: 51)

summer201401 · 发表于 2015-3-13 15:32

TomingTang 发表于 2015-3-13 14:33
1、11-16行哪里增加代码，增加需要汇总的项
2、插入到这个工作簿就可以了。
3、是需要你点击代码运行。代 ...

请帮忙调整一下代码，每次点击“提取数据”的时候，在原位置更新数据，而不是在第一次提取数据的下方，再提取一次。

summer201401 · 发表于 2015-3-16 08:34

顶上，研究了好久还是没有看明白，明明是相同的代码，为什么出来的效果就是不一样的呢

TomingTang · 发表于 2015-3-16 16:41

Sub 汇总()
Dim Arr(1 To 1000, 1 To 12), i%, j%, drow%, k%, ddrow%
i = 1
Dim sht As Worksheet '定义sht 为工作表
' Worksheets("汇总表").Range("a2:p65536").ClearContents
For Each sht In Worksheets
' With sht
' MsgBox sht.Name
If sht.Name <> "汇总表" Then
With sht
' drow = sht.Range("a65536").End(xlUp).Row
Arr(i, 2) = .Range("d4"): Arr(i, 3) = .Range("n4"): Arr(i, 4) = .Range("d5")
Arr(i, 5) = .Range("d6"): Arr(i, 6) = .Range("b2"): Arr(i, 7) = .Range("q19"):
Arr(i, 8) = .Range("q31"): Arr(i, 9) = .Range("q43"): Arr(i, 10) = .Range("q55"):
Arr(i, 11) = .Range("q67"): Arr(i, 12) = .Range("q72")
Arr(i, 1) = i
i = i + 1
End With
' ddrow = Worksheets("汇总").Range("a65531").End(xlUp).Row + 1
' MsgBox ddrow
End If
' End With
Next
Worksheets("汇总表").Range("a4:l1000").ClearContents
Worksheets("汇总表").Range("a4").Resize(UBound(Arr, 1), UBound(Arr, 2)) = Arr
End Sub

复制代码

表格数量不限制。目前看定义的数组量大小，我改成了1000
第三个已经改好了。

		自动登录	找回密码
密码			免费注册