1，多工作表汇总（Consolidate）
‘&ID=110630&page=1
‘两种写法都要求地址用R1C1形式，各个表格的数据布置有规定。
Sub ConsolidateWorkbook()
Dim RangeArray() As String
Dim bk As Worksheet
Dim sht As Worksheet
Dim WbCount As Integer
Set bk = Sheets("汇总")
WbCount =
ReDim RangeArray(1 To WbCount - 1)
For Each sht In Sheets
If <> "汇总" Then
i = i + 1
RangeArray(i) = "'" & & "'!" & _
("A1").(ReferenceStyle:=xlR1C1)
End If
Next
("A1").Consolidate RangeArray, xlSum, True, True
[a1].Value = "姓名"
End Sub
Sub sumdemo()
Dim arr As Variant
arr = Array("一月!R1C1:R8C5", "二月!R1C1:R5C4", "三月!R1C1:R9C6")
With Worksheets("汇总").Range("A1")
.Consolidate arr, xlSum, True, True
.Value = "姓名"
End With
End Sub
2，多工作簿汇总（Consolidate）
‘多工作簿汇总
Sub ConsolidateWorkbook()
Dim RangeArray() As String
Dim bk As Workbook
Dim sht As Worksheet
Dim WbCount As Integer
WbCount =
ReDim RangeArray(1 To WbCount - 1)
For Each bk In Workbooks '在所有工作簿中循环
If Not bk Is ThisWorkbook Then '非代码所在工作簿
Set sht = (1) '引用工作簿的第一个工作表
i = i + 1
RangeArray(i) = "'[" & & "]" & & "'!" & _
("A1").(ReferenceStyle:=xlR1C1)
End If
Next
resize函数c++ Worksheets(1).Range("A1").Consolidate _
RangeArray, xlSum, True, True
End Sub
3，多工作簿汇总（FileSearch）
‘2007-1-1‘help\汇总表.xls
Sub pldrwb0531()
'汇总表.xls
'导入指定文件的数据
Dim myFs As FileSearch
Dim myPath As String, Filename$
Dim i As Long, n As Long
Dim Sht1 As Worksheet, sh As Worksheet
Dim aa, nm$, nm1$, m, arr, r1, col1%
= False
Set Sht1 = ActiveSheet
Set myFs =
myPath =
With myFs
.NewSearch
.LookIn = myPath
.FileType = msoFileTypeNoteItem
.Filename = "*.xls"
If .Execute(SortBy:=msoSortByFileName) > 0 Then
n = .
col1 = 2
ReDim myfile(1 To n) As String
For i = 1 To n
myfile(i) = .FoundFiles(i)
Filename = myfile(i)
aa = InStrRev(Filename, "\")
nm = Right(Filename, Len(Filename) - aa)
nm1 = Left(nm, Len(nm) - 4)
If nm1 <> "汇总表" Then
myfile(i)
Dim wb As Workbook
Set wb = ActiveWorkbook
m = [a65536].End(xlUp).Row
arr = Range(Cells(3, 3), Cells(m, 3))
col1 = col1 + 1
Cells(2, col1) = nm '自动获取文件名
Cells(3, col1).Resize(UBound(arr), 1) = arr
savechanges:=False
Set wb = Nothing
End If
Next
Else
MsgBox "该文件夹里没有任何文件"
End If
End With
[a1].Select
Set myFs = Nothing
= True
End Sub
‘根据上例增加了在一个工作簿中可选择多个工作表进行汇总，运用了文本框多选功能
Public ar, ar1, nm$
Sub pldrwb0531()
'汇总表.xls
'导入指定文件的数据（默认工作表1的数据）
'直接从C列依次导入
Dim myFs As FileSearch
Dim myPath As String, Filename$
Dim i As Long, n As Long
Dim Sht1 As Worksheet, sh As Worksheet
Dim aa, nm1$, m, arr, r1, col1%
= False
On Error Resume Next
Set Sht1 = ActiveSheet
Set myFs =
myPath =
With myFs
.NewSearch
.LookIn = myPath
.FileType = msoFileTypeNoteItem
.Filename = "*.xls"
If .Execute(SortBy:=msoSortByFileName) > 0 Then
n = .
col1 = 2
ReDim myfile(1 To n) As String
For i = 1 To n
myfile(i) = .FoundFiles(i)
Filename = myfile(i)
aa = InStrRev(Filename, "\")
nm = Right(Filename, Len(Filename) - aa)
nm1 = Left(nm, Len(nm) - 4)
If nm1 <> "汇总表" Then
myfile(i)
Dim wb As Workbook
Set wb = ActiveWorkbook
For Each sh In Sheets
s = s & & ","
Next
s = Left(s, Len(s) - 1)
ar = Split(s, ",")
For j = 0 To UBound(ar1)
版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。
发表评论