2013.5多表汇总的例子
Excel多表汇总，你会写公式吗？
Excel多表汇总，你会写公式吗？Excel多表汇总，你会写公式吗？工作中经常遇到数据分散在不同的工作表的情况，需要对多张工作表数据进行汇总时，就要用到多表汇总技术了。
多表汇总的方法有很多种，今天来展示一个公式搞定多表汇总的方法。
这种方法最大优势在于当数据源变动时，公式结果可以自动更新，你知道这有多么重要！看完教程还想系统学习的同学，推荐你参加我亲自授课的特训营↓，系统提升自己。
应用场景和数据结构如下图所示，每个月份的数据分别放置在不同的工作表中其中工作表1放置的1月份数据，工作表2放置的2月份数据，依此类推需要在汇总工作表中进行多表汇总，按产品将1月、2月、3月的数据分类汇总统计。
汇总表中的黄色单元格为公式结果。
无论1/2/3月数据如何变动，汇总结果支持自动更新。
公式解法下面先告诉大家这个公式怎么写，再看演示效果。
B2输入以下数组公式，按<Ctrl+Shift+Enter>结束输入，并将公式向下填充=SUM(SUMIF(INDIRECT(ROW($1:$3)&"!b:b"),A2,INDIRECT( ROW($1:$3)&"!c:c")))效果演示为了方便大家清晰、直观地查看效果，我从空表状态填写数据，口算即可验证结果。
点击下图Gif观看动图演示这个公式不但支持数据源变动后结果自动更新，而且当分表中记录增加时，也可以自动更新数据，非常方便。
扩展说明当需要汇总的工作表月份增加时，比如要对1至12月的12张工作表汇总......这时，只需对公式进行简单调整即可=SUM(SUMIF(INDIRECT(ROW($1:$12)&"!b:b"),A2,INDIRECT( ROW($1:$12)&"!c:c")))如果你觉得有用，就分享给朋友们看看吧~。
不同列多表格汇总公式
不同列多表格汇总公式全文共四篇示例，供读者参考第一篇示例：在数据分析和报告中，常常需要将不同表格中的数据进行汇总和整合。
不同列多表格的汇总公式是一种非常有效的方法，可以帮助人们快速准确地统计和分析大量数据。
本文将介绍一些常用的不同列多表格汇总公式，帮助读者更好地理解和运用这些方法。
一、SUMIF函数SUMIF函数是Excel中非常常用的一种计算汇总的方法。
它可以根据指定的条件来汇总数据，在不同列多表格中尤其适用。
SUMIF函数的语法如下：=SUMIF( range, criteria, [sum_range] )range是要进行条件判断的数据范围，criteria是条件判断的标准，sum_range是要汇总的数据范围。
如果我们有两个表格，一个表格中包含员工姓名和销售额数据，另一个表格中包含员工姓名和费用数据，我们可以使用SUMIF函数来计算每个员工的净利润，公式如下：=SUMIF(表格1!A:A, A2, 表格1!B:B) - SUMIF(表格2!A:A, A2, 表格2!B:B)这个公式会先在表格1中找到与当前行员工姓名匹配的销售额，再在表格2中找到与当前行员工姓名匹配的费用，最后求差值得到净利润。
二、VLOOKUP函数VLOOKUP函数是另一种常用的不同列多表格汇总公式。
它可以在不同表格中查找指定的值，并返回相应的结果。
VLOOKUP函数的语法如下：=VLOOKUP( lookup_value, table_array, col_index_num, [range_lookup] )lookup_value是要查找的值，table_array是要查找的范围，col_index_num是返回结果所在列的索引号，range_lookup是一个逻辑值，表示是否使用近似匹配。
如果我们需要在一个表格中根据产品名称查找对应的价格，可以使用VLOOKUP函数，公式如下：=VLOOKUP(A2, 表格1!A:B, 2, FALSE)这个公式会在表格1的第一列中查找与当前行产品名称匹配的值，并返回该值所在列的第二列的数据，即价格。
excel2013多个数据怎么进行汇总
excel2013多个数据怎么进行汇总
推荐文章
Excel2013表格怎么按月年汇总日期数据热度： excel2013怎么对多个数据进行汇总热度：Excel2013怎么汇总数据热度：入党志愿书中的入党志愿怎么写热度：会计人员加薪申请书怎么写热度：在excel2013中输入了多个单元格数据，但是要对这些单元格进行汇总时，应该怎么做?下面随店铺一起来看看吧。
excel2013多个数据进行汇总的步骤
打开我准备好了的数据表格，先单击D列，然后点击菜单栏--数据--分列。
弹出文本分列向导，将文件类型选为分隔符号，单击下一步。
在分隔符号中勾选其他，填入顿号，因为原单元格中是以顿号隔开的，下一步。
填入目标区域，就是分隔之后显示的单元格，完成向导设置。
我们可以看见单元格数据被分隔开来了，在H2单元格输入=Sum(E2：G2)
回车，得到结果，双击填充柄，完成下面数据的计算，然后复制，单击开始选项卡下剪贴板里面的粘贴--粘贴值。
因为这里的结果是根据E：G列来计算的，之后我们要删除这几列，如果不粘贴为值的话，最后结果就无法显示了，出错。
删除中间那几列，将多余的数据去掉，完成最后的效果。
多表汇总再合并
多表汇总再合并1、说明：每月的人员都有变动，且有重名的出现，2、要求：效果是名字别出现遗漏.统计出每月的数据。
3、说明：此表我只选择了三张表，其实有12张表。
4、要求：能不能实现有几张表就统计几张表的？例如，我只有6、7、8三个月，就统计出这三个月的，如果有1、2、3、4、5这几个月的，就统计这五个月的。
此表为汇总的最终结果VBA代码如下：Sub 多表汇总合并()Dim Sht As Worksheet, Arr, BrrDim Dic As Object, x%, i&, k&, y&Set Dic = CreateObject("Scripting.Dictionary")ReDim Brr(1 To Rows.Count, 1 To 14)For Each Sht In SheetsIf <> ThenArr = edRangex = Val(Arr(1, 1)) + 2For i = 4 To UBound(Arr)If Arr(i, 1) <> "" And Arr(i, 2) <> "" ThenIf Not Dic.Exists((Arr(i, 1) & Arr(i, 2))) Thenk = k + 1Dic.Add Arr(i, 1) & Arr(i, 2), kBrr(k, 1) = Arr(i, 1)Brr(k, 2) = Arr(i, 2)Brr(k, x) = Arr(i, 3)Elsey = Dic(Arr(i, 1) & Arr(i, 2))Brr(y, x) = Brr(y, x) + Arr(i, 3)End IfEnd IfNextEnd IfNextedRange.Offset(1).ClearContents Sheet5.Range("A2").Resize(k, 14) = Brr End Sub。
不同表格中满足多个条件汇总数据的函数
标题：如何使用函数在不同表格中满足多个条件汇总数据在日常工作和学习中，我们经常会遇到需要在不同表格中满足多个条件汇总数据的情况。
这时就需要使用函数来实现这一目标。
本文将介绍如何使用函数在不同表格中满足多个条件汇总数据，并共享一些个人观点和理解。
一、函数简介在处理不同表格中满足多个条件汇总数据时，常用的函数包括SUMIF、COUNTIF、AVERAGEIF、SUMIFS、COUNTIFS和AVERAGEIFS。
这些函数能够根据设定的条件，在指定的范围内进行数据的求和、计数和求平均值操作。
二、使用范例假设我们有两个表格，分别记录了不同产品的销售额和销售量。
现在需要统计某个产品的销售额和销售量，同时满足特定条件（比如地区和时间）。
这时就可以使用SUMIFS、COUNTIFS和AVERAGEIFS等函数来实现这一目标。
在Excel中，我们可以按照以下格式使用这些函数：1. 使用SUMIFS函数汇总销售额：=SUMIFS(销售额范围, 产品范围, "产品A", 地区范围, "地区A", 时间范围, "2019年")2. 使用COUNTIFS函数汇总销售量：=COUNTIFS(销售量范围, 产品范围, "产品A", 地区范围, "地区A", 时间范围, "2019年")3. 使用AVERAGEIFS函数汇总平均销售额：=AVERAGEIFS(销售额范围, 产品范围, "产品A", 地区范围, "地区A", 时间范围, "2019年")通过这些函数的灵活运用，我们可以轻松地在不同表格中满足多个条件汇总数据，实现精确的数据分析和统计。
三、个人观点和理解在实际工作中，我发现函数在不同表格中满足多个条件汇总数据是非常实用的。
它不仅能够提高工作效率，还能够准确地分析数据，为决策提供有力支持。
ExcelV精选多工作簿多工作表汇总实例集锦
E x c e l V精选多工作簿多工作表汇总实例集锦 Revised by Liu Jing on January 12, 20211，多工作表汇总（C o n s o l i d a t e）‘‘两种写法都要求地址用R1C1形式，各个表格的数据布置有规定。
Sub ConsolidateWorkbook()Dim RangeArray() As StringDim bk As WorksheetDim sht As WorksheetDim WbCount As IntegerSet bk = Sheets("汇总")WbCount = Sheets.CountReDim RangeArray(1 To WbCount - 1)For Each sht In SheetsIf <> "汇总" Theni = i + 1RangeArray(i) = "'" & & "'!" & _sht.Range("A1").CurrentRegion.Address(ReferenceStyle:=xlR1C1)End IfNextbk.Range("A1").Consolidate RangeArray, xlSum, True, True[a1].Value = "姓名"End SubSub sumdemo()Dim arr As Variantarr = Array("一月!R1C1:R8C5", "二月!R1C1:R5C4", "三月!R1C1:R9C6")With Worksheets("汇总").Range("A1").Consolidate arr, xlSum, True, True.Value = "姓名"End WithEnd Sub2，多工作簿汇总（Consolidate）‘多工作簿汇总Sub ConsolidateWorkbook()Dim RangeArray() As StringDim bk As WorkbookDim sht As WorksheetDim WbCount As IntegerWbCount = Workbooks.CountReDim RangeArray(1 To WbCount - 1)For Each bk In Workbooks '在所有工作簿中循环If Not bk Is ThisWorkbook Then '非代码所在工作簿Set sht = bk.Worksheets(1) '引用工作簿的第一个工作表i = i + 1RangeArray(i) = "'[" & & "]" & & "'!" & _sht.Range("A1").CurrentRegion.Address(ReferenceStyle:=xlR1C1) End IfNextWorksheets(1).Range("A1").Consolidate _RangeArray, xlSum, True, TrueEnd Sub3，多工作簿汇总（FileSearch）‘2007-1-1.html###‘help\汇总表.xlsSub pldrwb0531()'汇总表.xls'导入指定文件的数据Dim myFs As FileSearchDim myPath As String, Filename$Dim i As Long, n As LongDim Sht1 As Worksheet, sh As WorksheetDim aa, nm$, nm1$, m, arr, r1, col1%Application.ScreenUpdating = FalseSet Sht1 = ActiveSheetSet myFs = Application.FileSearchmyPath = ThisWorkbook.PathWith myFs.NewSearch.LookIn = myPath.FileType = msoFileTypeNoteItem.Filename = "*.xls"If .Execute(SortBy:=msoSortByFileName) > 0 Then n = .FoundFiles.Countcol1 = 2ReDim myfile(1 To n) As StringFor i = 1 To nmyfile(i) = .FoundFiles(i)Filename = myfile(i)aa = InStrRev(Filename, "\")nm = Right(Filename, Len(Filename) - aa) nm1 = Left(nm, Len(nm) - 4)If nm1 <> "汇总表" ThenWorkbooks.Open myfile(i)Dim wb As WorkbookSet wb = ActiveWorkbookm = [a65536].End(xlUp).Rowarr = Range(Cells(3, 3), Cells(m, 3))Sht1.Activatecol1 = col1 + 1Cells(2, col1) = nm '自动获取文件名Cells(3, col1).Resize(UBound(arr), 1) = arr wb.Close savechanges:=FalseSet wb = NothingEnd IfNextElseMsgBox "该文件夹里没有任何文件"End IfEnd With[a1].SelectSet myFs = NothingApplication.ScreenUpdating = TrueEnd Sub‘根据上例增加了在一个工作簿中可选择多个工作表进行汇总，运用了文本框多选功能Public ar, ar1, nm$Sub pldrwb0531()'汇总表.xls'导入指定文件的数据（默认工作表1的数据）'直接从C列依次导入Dim myFs As FileSearchDim myPath As String, Filename$Dim i As Long, n As LongDim Sht1 As Worksheet, sh As WorksheetDim aa, nm1$, m, arr, r1, col1%Application.ScreenUpdating = FalseOn Error Resume NextSet Sht1 = ActiveSheetSet myFs = Application.FileSearchmyPath = ThisWorkbook.PathWith myFs.NewSearch.LookIn = myPath.FileType = msoFileTypeNoteItem.Filename = "*.xls"If .Execute(SortBy:=msoSortByFileName) > 0 Thenn = .FoundFiles.Countcol1 = 2ReDim myfile(1 To n) As StringFor i = 1 To nmyfile(i) = .FoundFiles(i)Filename = myfile(i)aa = InStrRev(Filename, "\")nm = Right(Filename, Len(Filename) - aa)nm1 = Left(nm, Len(nm) - 4)If nm1 <> "汇总表" ThenWorkbooks.Open myfile(i)Dim wb As WorkbookSet wb = ActiveWorkbookFor Each sh In Sheetss = s & & ","Nexts = Left(s, Len(s) - 1)ar = Split(s, ",")UserForm1.ShowFor j = 0 To UBound(ar1)If Err.Number = 9 Then GoTo 100Set sh = wb.Sheets(ar1(j))sh.Activatem = sh.[a65536].End(xlUp).Rowarr = Range(Cells(3, 3), Cells(m, 3))Sht1.Activatecol1 = col1 + 1Cells(2, col1) = sh.[a1]Cells(3, col1).FormulaR1C1 = "=[" & nm & "]" & ar1(j) & "!RC3" ‘显示引用的工作簿工作表及单元格地址Cells(3, col1).AutoFillRange(Cells(3, col1), Cells(UBound(arr) + 2, col1))‘Cells(3, col1).Resize(UBound(arr), 1) = arrNext j100: wb.Close savechanges:=FalseSet wb = Nothings = ""If VarType(ar1) = 8200 Then Erase ar1End IfNextElseMsgBox "该文件夹里没有任何文件"End IfEnd With[a1].SelectSet myFs = NothingApplication.ScreenUpdating = TrueEnd SubPrivate Sub CommandButton1_Click()For i = 0 To ListBox1.ListCount - 1If ListBox1.Selected(i) = True Thens = s & ListBox1.List(i) & ","End IfNext iIf s <> "" Thens = Left(s, Len(s) - 1)ar1 = Split(s, ",")MsgBox "你选择了 " & sUnload UserForm1Elsemg = MsgBox("你没有选择任何工作表！需要重新选择吗 ", vbYesNo, "提示")If mg = 6 ThenElseUnload UserForm1End IfEnd IfEnd SubPrivate Sub CommandButton2_Click()Unload UserForm1End SubPrivate Sub UserForm_Initialize()With Me.ListBox1.List = ar ‘文本框赋值.ListStyle = 1 ‘文本前加选择小方框.MultiSelect = 1 ‘设置可多选End WithEnd Sub4，多工作表汇总（字典、数组）‘‘Data多表汇总0623.xlsSub dbhz()'多表汇总Dim Sht1 As Worksheet, Sht2 As Worksheet, Sht As WorksheetDim d, k, t, Myr&, Arr, xApplication.ScreenUpdating = FalseApplication.DisplayAlerts = FalseSet d = CreateObject("Scripting.Dictionary")For Each Sht In Sheets ‘删除同名的表格，获得要增加的汇总表格不重复名字If InStr(, "-") > 0 Then Sht.Delete: GoTo 100nm = Mid(Sht.[a3], 7)d(nm) = ""100:Next ShtApplication.DisplayAlerts = Truek = d.keysFor i = 0 To UBound(k)Sheets.Add after:=Sheets(Sheets.Count)Set Sht1 = ActiveSheet = Replace(k(i), "/", "-") ‘增加汇总表，把名字中的”/”（不能用作表名的）改为”-“Next iErase kSet d = NothingFor Each Sht In SheetsWith Sht.ActivateIf InStr(.Name, "-") = 0 Thennm = Replace(Mid(.[a3], 7), "/", "-")Myr = .[h65536].End(xlUp).RowArr = .Range("d10:h" & Myr)Set d = CreateObject("Scripting.Dictionary") For i = 1 To UBound(Arr)x = Arr(i, 1)If Not d.exists(x) Thend.Add x, Arr(i, 5)Elsed(x) = d(x) + Arr(i, 5)End IfNextk = d.keyst = d.itemsSet Sht2 = Sheets(nm)Sht2.Activatemyr2 = [a65536].End(xlUp).Row + 1If myr2 < 9 ThenCells(9, 1).Resize(1, 2) = Array("PartNo.", "TTL Qty")Cells(10, 1).Resize(UBound(k) + 1, 1) = Application.Transpose(k)Cells(10, 2).Resize(UBound(t) + 1, 1) = Application.Transpose(t)ElseCells(myr2, 1).Resize(UBound(k) + 1, 1) = Application.Transpose(k)Cells(myr2, 2).Resize(UBound(t) + 1, 1) = Application.Transpose(t)End IfErase kErase tSet d = NothingEnd IfEnd WithNext ShtApplication.ScreenUpdating = TrueEnd Sub5，多工作簿提取指定数据（FileSearch）‘2011-8-31‘9188-1-1.htmlSub GetData()Dim Brrbz(1 To 200, 1 To 19), Brrgr(1 To 500, 1 To 23) Dim myFs As FileSearch, myfileDim myPath As String, Filename$, wbnm$Dim i&, n&, mm&, aa$, nm1$, j&Dim Sht1 As Worksheet, sh As Worksheet, wb1 As Workbook Application.ScreenUpdating = FalseSet wb1 = ThisWorkbookwbnm = Left(, Len() - 4)Set Sht1 = ActiveSheetSht1.[a2:w200] = ""aa = Left(, 2)Set myFs = Application.FileSearchmyPath = ThisWorkbook.Path & "\"With myFs.NewSearch.LookIn = myPath.FileType = msoFileTypeNoteItem.Filename = "*.xls".SearchSubFolders = TrueIf .Execute(SortBy:=msoSortByFileName) > 0 Thenn = .FoundFiles.CountReDim myfile(1 To n) As StringFor i = 1 To nmyfile(i) = .FoundFiles(i)Filename = myfile(i)nm1 = Split(Mid(Filename, InStrRev(Filename, "\") + 1), ".")(0)If nm1 = wbnm Then GoTo 200Workbooks.Open myfile(i)Dim wb As WorkbookSet wb = ActiveWorkbookFor Each sh In SheetsIf InStr(, aa) Thensh.ActivateIf aa = "班子" Thenmm = mm + 1Brrbz(mm, 1) = [b2].ValueFor j = 2 To 18 Step 2If j < 10 ThenBrrbz(mm, j) = Cells(j / 2 + 34, 11).ValueElseBrrbz(mm, j) = Cells(j / 2 + 34, 9).ValueEnd IfNextGoTo 100ElseIf [b2] = "" Then GoTo 50mm = mm + 1Brrgr(mm, 1) = [b2].ValueBrrgr(mm, 2) = [e38].ValueBrrgr(mm, 3) = [i38].ValueFor j = 4 To 18 Step 2If j < 12 ThenBrrgr(mm, j) = Cells(j / 2 + 38, 8).ValueElseBrrgr(mm, j) = Cells(j / 2 + 38, 7).ValueEnd IfNextFor j = 20 To 23Brrgr(mm, j) = Cells(j + 28, 8).ValueNextEnd IfEnd If50:Next100:wb.Close savechanges:=FalseSet wb = Nothing200:NextElseMsgBox "该文件夹里没有任何文件"End IfEnd WithIf aa = "班子" Then[a2].Resize(mm, 19) = BrrbzElse[a2].Resize(mm, 23) = BrrgrEnd If[a1].SelectSet myFs = NothingEnd Sub‘2011-7-15‘Sub pldrsj()'批量导入指定文件的数据Dim myFs As FileSearch, myfile, BrrDim myPath$, Filename$, nm2$Dim i&, j&, n&, aa$, nm$Dim Sht1 As Worksheet, sh As Worksheet Application.ScreenUpdating = FalseSet Sht1 = ActiveSheetnm2 = Set myFs = Application.FileSearchmyPath = ThisWorkbook.PathWith myFs.NewSearch.LookIn = myPath.FileType = msoFileTypeNoteItem.Filename = "*.xls".SearchSubFolders = TrueIf .Execute(SortBy:=msoSortByFileName) > 0 Thenn = .FoundFiles.CountReDim Brr(1 To n, 1 To 2)ReDim myfile(1 To n) As StringFor i = 1 To nmyfile(i) = .FoundFiles(i)Filename = myfile(i)aa = InStrRev(Filename, "\")nm = Right(Filename, Len(Filename) - aa) '带后缀的Excel 文件名If nm <> nm2 Thenj = j + 1Workbooks.Open myfile(i)Dim wb As WorkbookSet wb = ActiveWorkbookSet sh = wb.Sheets("Sheet1")Brr(j, 1) = nmBrr(j, 2) = sh.[c3].Valuewb.Close savechanges:=FalseSet wb = NothingEnd IfNextElseMsgBox "该文件夹里没有任何文件"End IfEnd WithSht1.Select[a3].Resize(UBound(Brr), 2) = BrrSet myFs = NothingApplication.ScreenUpdating = TrueEnd SubSub pldrsj0707()6387-1-1.html'Report 2.xls'批量导入指定文件的数据Dim myFs As FileSearch, myfileDim myPath As String, Filename$, ma&, mc&Dim i As Long, n As Long, nn&, aa$, nm$, nm1$ Dim Sht1 As Worksheet, sh As WorksheetApplication.ScreenUpdating = FalseSet Sht1 = ActiveSheet: nn = 5Sht1.[b5:e27] = ""Set myFs = Application.FileSearchmyPath = ThisWorkbook.Path & "\data" ‘指定的子文件夹内搜索With myFs.NewSearch.LookIn = myPath.FileType = msoFileTypeNoteItem.Filename = "*.xls".SearchSubFolders = TrueIf .Execute(SortBy:=msoSortByFileName) > 0 Thenn = .FoundFiles.CountReDim myfile(1 To n) As StringFor i = 1 To nmyfile(i) = .FoundFiles(i)Filename = myfile(i)nm1=split(mid(filename,instrrev(filename,"\")+1),".")(0) 一句代码代替以下3句‘aa = InStrRev(Filename, "\")‘nm = Right(Filename, Len(Filename) - aa) '带后缀的Excel文件名‘nm1 = Left(nm, Len(nm) - 4) '去除后缀的Excel文件名If nm1 <> ThenWorkbooks.Open myfile(i)Dim wb As WorkbookSet wb = ActiveWorkbookFor Each sh In Sheetssh.Activatema = [b65536].End(xlUp).RowIf ma > 6 Then ‘第6行是表头If ma > 10 Then ma = 10 ‘只要取4行数据For ii = 7 To maSht1.Cells(nn,2).Resize(1, 3) = Cells(ii, 2).Resize(1, 3).ValueSht1.Cells(nn, 5) = Cells(ii, 6).Valuenn = nn + 1Next iiGoTo 100ElseGoTo 100End Ifmc = [d65536].End(xlUp).RowIf mc > 7 Then ‘第7行是表头 If mc > 11 Then mc = 11 ‘只要取4行数据For ii = 8 To mcSht1.Cells(nn,2).Resize(1, 3) = Cells(ii, 4).Resize(1, 3).ValueSht1.Cells(nn, 5) = Cells(ii, 8).Valuenn = nn + 1Next iiGoTo 100ElseGoTo 100End If100:Next shwb.Close savechanges:=FalseSet wb = NothingEnd IfNextElseMsgBox "该文件夹里没有任何文件"End IfEnd With[a1].SelectSet myFs = NothingApplication.ScreenUpdating = TrueEnd Sub‘‘sum.xlsSub pldrsj0724()'批量导入指定文件的数据Dim myFs As FileSearch, myfile, Myr1&, ArrDim myPath$, Filename$, nm2$Dim i&, j&, n&, nn&, aa$, nm$, nm1$Dim Sht1 As Worksheet, sh As WorksheetApplication.ScreenUpdating = FalseSet Sht1 = ActiveSheetMyr1 = Sht1.[a65536].End(xlUp).RowArr = Sht1.Range("a3:b" & Myr1)Sht1.Range("b3:b" & Myr1).ClearContentsnm2 = Left(, Len() - 4)Set myFs = Application.FileSearchmyPath = ThisWorkbook.PathWith myFs.NewSearch.LookIn = myPath.FileType = msoFileTypeNoteItem.Filename = "*.xls"If .Execute(SortBy:=msoSortByFileName) > 0 Thenn = .FoundFiles.CountReDim myfile(1 To n) As StringFor i = 1 To nmyfile(i) = .FoundFiles(i)Filename = myfile(i)aa = InStrRev(Filename, "\")nm = Right(Filename, Len(Filename) - aa) '带后缀的Excel文件名nm1 = Left(nm, Len(nm) - 4) '去除后缀的Excel文件名If nm1 <> nm2 ThenWorkbooks.Open myfile(i)Dim wb As WorkbookSet wb = ActiveWorkbookFor Each sh In SheetsFor j = 1 To UBound(Arr)If = Arr(j, 1) Then sh.ActivateSet r1 =Range("c:c").Find()nn = r1.RowArr(j, 2) = Cells(nn, 9) GoTo 100End IfNext jNext sh100:wb.Close savechanges:=FalseSet wb = NothingEnd IfNextElseMsgBox "该文件夹里没有任何文件"End IfEnd WithSht1.Select[b3].Resize(UBound(Arr), 1) = Application.Index(Arr, 0, 2) Set myFs = NothingApplication.ScreenUpdating = TrueEnd Sub6，多工作表提取指定数据（数组）‘Sub fpkf()Application.ScreenUpdating = FalseDim Myr&, Arr, yf, x&, Myr1&, r1Dim Sht As WorksheetMyr = Sheet1.[b65536].End(xlUp).RowSheet1.Range("c8:h" & Myr).ClearContentsArr = Sheet1.Range("c8:h" & Myr)[j8].Formula = "=rc[-9]&""|""&rc[-8]"[j8].AutoFill Range("j8:j" & Myr)Range("j8:j" & Myr) = Range("j8:j" & Myr).ValueFor Each Sht In SheetsIf <> Thenyf = Left(, Len() - 2)Sht.ActivateMyr1 = [a65536].End(xlUp).Row - 1For x = 7 To Myr1If Cells(x, 1) <> "" ThenSet r1 = Sheet1.Range("j:j").Find(Cells(x, 1) & "|" & Cells(x, 2))If Not r1 Is Nothing ThenArr(r1.Row - 7, yf) = Cells(x, "ar")End IfEnd IfNext xEnd IfNextSheet1.Activate[c8].Resize(UBound(Arr), UBound(Arr, 2)) = Arr[j:j].ClearApplication.ScreenUpdating = TrueEnd Sub7，多工作簿多工作表查询汇总去重复值（字典数组）‘‘详细记录.xls‘3个工作簿需要都打开Sub xxjl()Dim Sht1 As Worksheet, Sht As WorksheetDim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook Dim i&, Myr2&, Arr2, Myr&, Arr, Myr1&, xm$, yl$ Application.ScreenUpdating = FalseSet wb1 = ActiveWorkbookSet wb2 = Workbooks("购进")Set wb3 = Workbooks("配料")wb2.ActivateMyr2 = [a65536].End(xlUp).RowArr2 = Range("a2:d" & Myr2)wb3.ActivateFor i = 1 To UBound(Arr2)wb3.Activatexm = Arr2(i, 2)For Each Sht In SheetsIf = xm ThenSht.ActivateMyr = [a65536].End(xlUp).RowArr = Range("a1:b" & Myr)For j = 1 To UBound(Arr)yl = Arr(j, 1)wb1.ActivateFor Each Sht1 In SheetsIf = yl ThenSht1.ActivateMyr1 = [a65536].End(xlUp).Row + 1Cells(Myr1, 1) = Arr2(i, 1)Cells(Myr1, 3) = Arr2(i, 3)Cells(Myr1, 2) = Arr2(i, 4) * Arr(j, 2) Exit ForEnd IfNextNext jGoTo 100End IfNext100:Next iCall qccfApplication.ScreenUpdating = TrueEnd SubSub qccf()Dim Sht As Worksheet, Myr&, Arr, i&, xDim d, k, t, Arr1, j&Application.ScreenUpdating = FalseFor Each Sht In SheetsSht.ActivateMyr = [a65536].End(xlUp).RowArr = Range("a2:c" & Myr)Set d = CreateObject("Scripting.Dictionary") If Myr < 3 Then GoTo 100For i = 1 To UBound(Arr)x = Arr(i, 1) & "," & Arr(i, 3)If Not d.exists(x) Thend(x) = Arr(i, 2)Elsed(x) = d(x) + Arr(i, 2)End IfNextk = d.keyst = d.itemsReDim Arr1(1 To UBound(k) + 1, 1 To 3)For j = 0 To UBound(k)Arr1(j + 1, 1) = Split(k(j), ",")(0)Arr1(j + 1, 3) = Split(k(j), ",")(1)Arr1(j + 1, 2) = t(j)Next jRange("a2:c" & Myr).ClearContents[a2].Resize(UBound(Arr1), 3) = Arr1 100:Set d = NothingNextApplication.ScreenUpdating = TrueEnd Sub8，多工作簿对比（FileSearch）‘599&pid=3285214&page=1&extra=page%3D1 Sub dgzbdb()'多工作簿对比'by:蓝桥 2009-11-7Dim myFs As FileSearchDim myPath As String, Filename$Dim i&, n&, nm$, myfileDim Sht1 As Worksheet, sh As Worksheet Dim wb1 As Workbook, yf, j&, m1&Dim m, arr, r1Application.ScreenUpdating = False Application.DisplayAlerts = FalseOn Error Resume NextSet wb1 = ThisWorkbookSet myFs = Application.FileSearchmyPath = ThisWorkbook.PathFor Each Sht1 In SheetsIf InStr(Sht1.[a1], "费用明细表") > 0 Thennm = Left(Sht1.[a1], Len(Sht1.[a1]) - 5)Sht1.ActivateWith myFs.NewSearch.LookIn = myPath.FileType = msoFileTypeNoteItem.Filename = nm & ".xls".SearchSubFolders = TrueIf .Execute(SortBy:=msoSortByFileName) > 0 Then myfile = .FoundFiles(1)Workbooks.Open myfileDim wb As WorkbookSet wb = ActiveWorkbookSet sh = wb.ActiveSheetm = sh.[a65536].End(xlUp).Rowarr = sh.Range(Cells(2, 1), Cells(m, 6))yf = Val(Split(arr(2, 1), ".")(1))Sht1.ActivateFor j = 1 To UBound(arr)Set r1 = Sht1.Range("c:c").Find(arr(j, 3)) If r1 Is Nothing Thenm1 = Sht1.[d65536].End(xlUp).RowCells(m1, 1).EntireRow.Insert shift:=xlUp Cells(m1, 1) = Cells(m1 - 1, 1) + 1Cells(m1, 2) = arr(j, 3)Cells(m1, yf + 3) = arr(j, 6)End IfNext jwb.Close savechanges:=FalseSet wb = NothingEnd IfEnd WithEnd IfNextSet myFs = NothingApplication.DisplayAlerts = TrueApplication.ScreenUpdating = TrueEnd Sub9，多工作簿汇总（FileSearch+字典）‘Sub pldrwb1123()'合并.xls'导入指定文件的数据Dim myFs As FileSearchDim myPath As String, Filename$Dim i&, n&, y&, bb, j&, xDim Sht1 As Worksheet, sh As Worksheet Dim aa, nm$, nm1$, m, Arr, r1, mm&Dim d, k, t, d1, t1Application.ScreenUpdating = Falsemm = 8Set Sht1 = ActiveSheetSht1.[a8:h1000].ClearContentsSet myFs = Application.FileSearchmyPath = ThisWorkbook.PathWith myFs.NewSearch.LookIn = myPath.FileType = msoFileTypeNoteItem.Filename = "*.xls".SearchSubFolders = TrueIf .Execute(SortBy:=msoSortByFileName) > 0 Thenn = .FoundFiles.CountReDim myfile(1 To n) As StringFor i = 1 To nmyfile(i) = .FoundFiles(i)Filename = myfile(i)aa = InStrRev(Filename, "\")nm = Right(Filename, Len(Filename) - aa)nm1 = Left(nm, Len(nm) - 4)If nm1 <> "合并" ThenWorkbooks.Open myfile(i)Dim wb As WorkbookSet wb = ActiveWorkbookm = [a65536].End(xlUp).RowArr = Range(Cells(8, 1), Cells(m, 7))Set d = CreateObject("Scripting.Dictionary") Set d1 =CreateObject("Scripting.Dictionary")For j = 1 To UBound(Arr)x = Year(Arr(j, 1)) & "年" &Month(Arr(j, 1)) & "月" & "|" & Arr(j, 2) & "|" & Arr(j, 3) & "|" & Arr(j, 5)d(x) = d(x) + Arr(j, 4)d1(x) = Arr(j, 7)Nextk = d.keyst = d.itemst1 = d1.itemsSht1.ActivateFor y = 0 To UBound(k)bb = Split(k(y), "|")Cells(mm, 1) = nm1Cells(mm, 2) = bb(0)Cells(mm, 3) = bb(1)Cells(mm, 4) = bb(2)Cells(mm, 5) = t(y)Cells(mm, 6) = bb(3)Cells(mm, 7) = t(y) * bb(3)Cells(mm, 8) = t1(y)mm = mm + 1Nextwb.Close savechanges:=FalseSet wb = NothingSet d = NothingSet d1 = NothingEnd IfNextElseMsgBox "该文件夹里没有任何文件"End IfEnd With[a1].SelectSet myFs = NothingApplication.ScreenUpdating = TrueEnd Sub10，多工作簿多工作表提取数据（Do While）‘3D1‘年度汇总.xlsSub ndhz()Dim Arr, myPath$, myName$, wb As Workbook, sh As Worksheet Dim m&, funm$, shnm$, col%, i&Application.ScreenUpdating = FalseSet wb = ThisWorkbookfunm = "年度汇总.xls"myPath = ThisWorkbook.Path & "\"myName = Dir(myPath & "*.xls")Do While myName <> "" And myName <> funmWith GetObject(myPath & myName)Arr = .Sheets("领料").Range("A1").CurrentRegion For Each sh In wb.Sheetsshnm = sh.ActivateIf InStr(shnm, "班") > 0 Thencol = 11Elsecol = 7End IfFor i = 2 To UBound(Arr)If Arr(i, col) = shnm Thenm = sh.[a65536].End(xlUp).Row + 1 Cells(m, 1).Resize(1, 12) = Application.Index(Arr, i, 0)End IfNextNext.Close FalseEnd WithmyName = DirLoopApplication.ScreenUpdating = TrueEnd Sub‘Sub tqsj()Dim Arr, myPath$, myName$, wb As Workbook, sh As Worksheet Dim m&, funm$, shnm$, col%, i&, Myr&, Sht1 As Worksheet, pm$Application.ScreenUpdating = FalseOn Error Resume NextSet Sht1 = ActiveSheet[a2:g1000].ClearContentsfunm = "提取数据.xls": m = 1myPath = ThisWorkbook.Path & "\"myName = Dir(myPath & "*.xls")Do While myName <> "" And myName <> funmWith GetObject(myPath & myName)Set wb = Workbooks(myName)For Each sh In wb.Sheetsshnm = sh.Activatepm = sh.[a4].ValueMyr = sh.[a65536].End(xlUp).RowArr = sh.Range("b9:e" & Myr)m = m + 1With Sht1.Cells(m, 1) = myName.Cells(m, 2) = pm.Cells(m, 3) = shnm.Cells(m, 4).Resize(UBound(Arr), 4) = Arr End Withm = m + UBound(Arr) - 1Next.Close FalseEnd WithmyName = DirLoopApplication.ScreenUpdating = TrueEnd Sub‘‘我想要的结果.xlsSub zdgx()Dim Arr, myPath$, myName$, sh As Worksheet Dim m&, funm$, n&, Sht As WorksheetApplication.ScreenUpdating = Falsefunm = "我想要的结果.xls"Set Sht = ActiveSheetSht.[a2:f1000].ClearContentsSht.[a2:f1000].Borders.LineStyle = xlNone myPath = ThisWorkbook.Path & "\"myName = Dir(myPath & "*.xls")n = 2Do While myName <> "" And myName <> funm With GetObject(myPath & myName)Set sh = .Sheets("Sheet1")m = sh.[a65536].End(xlUp).RowArr = sh.Range("a2:f" & m)Cells(n, 1).Resize(m - 1, 6) = Arr n = n + m - 1.Close FalseEnd WithmyName = DirLoopSht.Range("a2:f" & n - 1).Borders.LineStyle = 1Application.ScreenUpdating = TrueEnd Sub‘‘汇总工作表.xls 2010-2-7Sub ndhz()Dim Arr, myPath$, myName$, wb As Workbook, sh As Worksheet Dim m&, funm$, shnm$, col%, i&, Myr&, Sht1 As WorksheetApplication.ScreenUpdating = FalseOn Error Resume NextSet Sht1 = ActiveSheetfunm = "汇总工作表.xls": m = 1myPath = ThisWorkbook.Path & "\"myName = Dir(myPath & "*.xls")Do While myName <> "" And myName <> funmWith GetObject(myPath & myName)Set wb = Workbooks(myName)For Each sh In wb.Sheetsshnm = sh.ActivateMyr = sh.[a65536].End(xlUp).RowArr = sh.Range("a1:c" & Myr)For i = 1 To UBound(Arr)If Arr(i, 3) > 50 Thenm = m + 1Sht1.Cells(m, 1).Resize(1, 3) = Application.Index(Arr, i, 0)Sht1.Cells(m, 4) = Arr(i + 1, 3)Sht1.Cells(m, 5) = Arr(i + 2, 3)Sht1.Cells(m, 6) = shnmEnd IfNextNext.Close FalseEnd WithmyName = DirLoopApplication.ScreenUpdating = TrueEnd Sub‘Sub ndhz()Dim Arr, myPath$, myName$, wb As Workbook, sh As Worksheet Dim m&, funm$, shnm$, col%, i&, Myr&, Sht1 As WorksheetApplication.ScreenUpdating = FalseOn Error Resume NextSet Sht1 = ActiveSheetfunm = "汇总工作表.xls": m = 1myPath = ThisWorkbook.Path & "\"myName = Dir(myPath & "*.xls")Do While myName <> "" And myName <> funmWith GetObject(myPath & myName)Set wb = Workbooks(myName)For Each sh In wb.Sheetsshnm = sh.ActivateMyr = sh.[a65536].End(xlUp).RowArr = sh.Range("a1:c" & Myr)For i = 1 To UBound(Arr)If Arr(i, 3) > 50 Thenm = m + 1Sht1.Cells(m, 1).Resize(1, 3) = Application.Index(Arr, i, 0)Sht1.Cells(m, 4) = Arr(i + 1, 3) Sht1.Cells(m, 5) = Arr(i + 2, 3) Sht1.Cells(m, 6) = shnmEnd IfNextNext.Close FalseEnd WithmyName = DirLoopApplication.ScreenUpdating = TrueEnd Sub‘9493-1-1.htmlSub ndhz() ‘设置工作表在此处要用Sheets("汇总")格式Dim Arr, myPath$, myName$, wb As Workbook, sh As Worksheet Dim m&, funm$, shnm$, n%, i&, wb1 As WorkbookApplication.ScreenUpdating = FalseSet wb = ThisWorkbookfunm = "汇总.xls": n = 1myPath = ThisWorkbook.Path & "\"myName = Dir(myPath & "*.xls")wb.Sheets("汇总").[a2:e100].ClearDo While myName <> "" And myName <> funmWith GetObject(myPath & myName)Set wb1 = Workbooks(myName)Set sh = wb1.Sheets("Sheet1")m = sh.[a65536].End(xlUp).RowWith wb.Sheets("汇总")n = n + 1.Cells(n, 1) = sh.[b2].Value.Cells(n, 2) = sh.[c2].Value.Cells(n, 3) = Application.Sum(sh.[e2].Resize(m - 1, 1)).Cells(n, 4) = Application.Sum(sh.[f2].Resize(m - 1, 1)).Cells(n, 5) = Application.Sum(sh.[g2].Resize(m - 1, 1))End With.Close FalseEnd WithmyName = DirLoopwb.Sheets("汇总").Range("a2:e" & n).Borders.LineStyle = 1Application.ScreenUpdating = TrueEnd Sub0459-1-1.html‘ABC.xls 2010-5-28Sub dgzbsj()Dim Arr, i&, sh$, n&, myPath$, shnm$, nm$, ad$Dim Sht As Worksheet, m&, Arr1, r1On Error Resume NextApplication.ScreenUpdating = FalsemyPath = ThisWorkbook.Path & "\"sh = Dir(myPath & "*.xls")While Not Len(sh) = 0If sh <> ThenWith GetObject(myPath & sh)Set Sht = .Sheets("Sheet1") ‘要用set以后才能取到数据m = Sht.[b65536].End(xlUp).RowArr = Sht.Range("b3:e" & m)Arr1 = Sht.Range("b4:e" & m)shnm = Left(sh, Len(sh) - 4)For i = 1 To UBound(Arr, 2)nm = Arr(1, i)Sheets(nm).ActivateSet r1 = Cells.Find(shnm, , , 1)If Not r1 Is Nothing Then。
Excel表格中如何快速汇总多个数据表中的数据.doc
Excel表格中如何快速汇总多个数据表中的数据Excel表格中如何快速汇总多个数据表中的数据实用技能酱08.19 14:57阅读171万+在Excel工作表中，如果需要汇总报告多个单独单元格的结果，可以将这些单元格中的数据合并到一个主工作表中。
这些工作表可以与主工作表在同一个工作簿中，也可以分别位于不同的工作簿。
数据的合并计算就是数据的组合过程，下面介绍Excel表格中汇总多个数据表中的数据的具体操作方法。
1、打开需要处理的工作簿，在这个工作簿中，“11月采购表”和“12月采购表”工作表包含需要合并的数据，如图1所示。
“合计”工作表用于放置进行合并计算后的数据，其结构如图2所示。
imgLoadingExcel表格中如何快速汇总多个数据表中的数据图1需要合并的两张工作表imgLoadingExcel表格中如何快速汇总多个数据表中的数据图2“合计”工作表的结构2、在“合计”工作表中单击选择放置合并计算结果的单元格区域中的第一个单元格，然后在功能区“数据”选项卡的“数据工具”组中单击“合并计算”按钮，如图3所示。
imgLoadingExcel表格中如何快速汇总多个数据表中的数据图3单击“合并计3、打开“合并计算”对话框，在“函数”下拉列表框中选择“求和”选项设置合并数据时的计算方式，然后单击“引用位置”文本框右侧的“参照”按钮，如图4所示。
打开“11月采购表”工作表，在工作表中拖动鼠标选择引用单元格后再次单击“参照”按钮，如图5所示。
imgLoadingExcel表格中如何快速汇总多个数据表中的数据图4单击参照按钮imgLoadingExcel表格中如何快速汇总多个数据表中的数据图5选择引用位置4、在“合并计算”对话框中单击“添加”按钮将选择的数据添加到“所有引用位置”列表框中，如图6所示。
imgLoadingExcel表格中如何快速汇总多个数据表中的数据图6添加数据区域到列表框5、单击“合并计算”对话框中“引用位置”文本框右侧的“参照”按钮，采用相同的方法将“12月采购表”工作表中需要合并的数据所在的单元格地址添加到“所有引用位置”列表框中，如图7所示。
利用sum sumif indirect row函数跨表取数实现多表汇总!
利用sum sumif indirect row函数跨表取数实现多表汇总！1、sumif函数对不同月份不同顺序的费用金额进行汇总，如SUMIF('1'！C4:C84'),C5,'1'!e4:e84'))+SUMIF('2'！C4:C84'),C5,'2'!e4:e84'))+...+SUMIF('12'！C4:C84'),C5,'12'!e4:e84'))2、利用INDIRECT函数可以利用数组的特性，简化公式，SUMIF(INDIRECT{1;2;3;4;5;6;7;8;9;10;11;12}&'!C4:C84'，c4,INDIRECT({1;2;3;4;5;6;7;8;9;10;11;12}&'!e4:e84'))3、利用row函数取数组，再次简化函数，SUMIF(INDIRECT(ROW($1:$12)&'!C4:C84'),C4,INDIRECT( ROW($1:$12)&'!e4:e84'))4、利用sum函数作汇总，SUM(SUMIF(INDIRECT(ROW($1:$12)&'!C4:C84'),C4,INDI RECT(ROW($1:$12)&'!e4:e84')))表中也使用了excel 2010下的sumifs函数，参数的顺序不一样，大家可能参考帮助学习使用。
需要说明的是利用indirect时一定注意连接号“&”及英文状态下的双引号“''”，否则会出错。
藤椅3楼snow5112014-4-12 16:04:48 非常感谢，希望笨鸟也能看懂。
板凳4楼snow5112014-4-12 16:11:01 您那个部门是哪来的？报纸5楼漂泊的旅途2014-4-12 16:18:43 引用: snow511 发表于2014-4-12 16:11您那个部门是哪来的？系统数据导出整理的，我们单位分部门考核费用！实际上我们整理数据时，根据需要有调整的。