用vba写一段代码,合并多个exl中多个sheet

时间: 2023-06-02 22:02:51 浏览: 88
以下是一段可以合并多个Excel文件中多个sheet的VBA代码: ``` Sub MergeSheets() Dim myPath As String Dim myFile As String Dim myExtension As String Dim FldrPicker As FileDialog Dim wbSource As Workbook, wbDest As Workbook Dim wsSource As Worksheet, wsDest As Worksheet Dim lRow As Long, lCol As Long 'Prompt user to select folder containing Excel files to merge Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) FldrPicker.Title = "Select a Folder" FldrPicker.Show myPath = FldrPicker.SelectedItems(1) & "\" 'Set file extension type myExtension = "*.xls*" 'Loop through all Excel files in folder myFile = Dir(myPath & myExtension) Set wbDest = Workbooks.Add(xlWBATWorksheet) Do While myFile <> "" 'Open each workbook in folder Set wbSource = Workbooks.Open(myPath & myFile) 'Loop through all worksheets in workbook For Each wsSource In wbSource.Worksheets 'Copy data from source worksheet to destination workbook Set wsDest = wbDest.Worksheets.Add(After:=wbDest.Worksheets(wbDest.Worksheets.Count)) wsDest.Name = wsSource.Name lRow = wsSource.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row lCol = wsSource.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column wsSource.Range(Cells(1, 1), Cells(lRow, lCol)).Copy wsDest.Range("A1") Next wsSource 'Close source workbook wbSource.Close SaveChanges:=False 'Get next file name myFile = Dir() Loop 'Save and close destination workbook wbDest.SaveAs myPath & "Merged.xlsx", FileFormat:=xlOpenXMLWorkbook wbDest.Close 'Alert user that the process is complete MsgBox "Sheets have been merged successfully!" End Sub ``` 此代码将提示用户选择包含要合并的Excel文件的文件夹。然后,它将循环遍历该文件夹中的所有Excel文件,并将每个文件中的每个工作表的数据复制到一个新的工作簿中。最后,它将新工作簿保存为一个名为“Merged.xlsx”的文件。

相关推荐

以下是VBA代码实现您的需求: Sub SearchAndCount() Dim searchFolder As String '要搜索的文件夹路径 Dim resultFile As String '结果文件路径 Dim searchText As String '待搜索的文本 Dim count As Long '计数器 Dim wb As Workbook '工作簿对象 Dim ws As Worksheet '工作表对象 Dim newWb As Workbook '新建的工作簿对象 Dim newWs As Worksheet '新建的工作表对象 Dim row As Long '行计数器 '设置要搜索的文件夹路径和待搜索的文本 searchFolder = "C:\Users\Username\Desktop\新建文件夹检索\" resultFile = "C:\Users\Username\Desktop\新建文件夹检索结果.xlsx" searchText = "特瑞普利单抗" '创建新的工作簿和工作表 Set newWb = Workbooks.Add Set newWs = newWb.Sheets(1) '在新建的工作表中写入表头 newWs.Range("A1").Value = "Sheet名称" newWs.Range("B1").Value = "计数" '遍历文件夹中的所有excel文件 Dim file As String file = Dir(searchFolder & "*.xls*") Do Until file = "" Set wb = Workbooks.Open(searchFolder & file) '打开文件 For Each ws In wb.Sheets '遍历所有工作表 count = 0 '重置计数器 For Each cell In ws.UsedRange '遍历工作表中所有单元格 If InStr(1, cell.Value, searchText, vbTextCompare) > 0 Then '如果单元格中包含待搜索的文本 count = count + 1 '计数器加1 End If Next cell '将结果写入新建的工作表中 row = newWs.Cells(Rows.Count, 1).End(xlUp).Row + 1 '获取下一个空行 newWs.Cells(row, 1).Value = ws.Name '写入工作表名称 newWs.Cells(row, 2).Value = count '写入计数结果 Next ws wb.Close False '关闭文件,不保存 file = Dir '获取下一个文件 Loop '保存并关闭新建的工作簿 newWb.SaveAs resultFile newWb.Close End Sub 您只需要将代码中的文件夹路径和待搜索的文本替换成您的实际路径和文本,然后运行该宏即可实现您的需求。注意,如果您的电脑中没有安装Excel软件,则无法运行该代码。
以下是代码实现: VBA Sub SearchAndCount() Dim folderPath As String Dim fileName As String Dim sheetName As String Dim searchText As String Dim totalCount As Integer Dim currentCount As Integer Dim newWorkbook As Workbook Dim currentWorkbook As Workbook Dim currentWorksheet As Worksheet '设置文件夹路径和搜索文本 folderPath = Environ("USERPROFILE") & "\Desktop\新建文件夹检索\" searchText = "特瑞普利单抗" '创建新的工作簿 Set newWorkbook = Workbooks.Add newWorkbook.SaveAs Environ("USERPROFILE") & "\Desktop\搜索结果.xlsx" '遍历文件夹中的所有Excel文件 fileName = Dir(folderPath & "*.xlsx") Do While fileName <> "" '打开当前Excel文件 Set currentWorkbook = Workbooks.Open(folderPath & fileName) '遍历当前Excel文件中的所有sheet For Each currentWorksheet In currentWorkbook.Worksheets currentCount = 0 '在当前sheet中搜索文本 For Each cell In currentWorksheet.UsedRange.Cells If InStr(1, cell.Value, searchText) > 0 Then currentCount = currentCount + 1 End If Next cell '将搜索结果写入新工作簿 If currentCount > 0 Then totalCount = totalCount + currentCount newWorkbook.Worksheets.Add newWorkbook.ActiveSheet.Name = currentWorkbook.Name & "-" & currentWorksheet.Name newWorkbook.ActiveSheet.Range("A1") = "搜索结果" newWorkbook.ActiveSheet.Range("A2") = "文件名" newWorkbook.ActiveSheet.Range("B2") = "sheet名" newWorkbook.ActiveSheet.Range("C2") = "出现次数" newWorkbook.ActiveSheet.Range("A3") = fileName newWorkbook.ActiveSheet.Range("B3") = currentWorksheet.Name newWorkbook.ActiveSheet.Range("C3") = currentCount End If Next currentWorksheet '关闭当前Excel文件 currentWorkbook.Close False '获取下一个Excel文件名 fileName = Dir() Loop '将搜索结果写入新工作簿的总表 newWorkbook.Worksheets.Add newWorkbook.ActiveSheet.Name = "总表" newWorkbook.ActiveSheet.Range("A1") = "总搜索结果" newWorkbook.ActiveSheet.Range("A2") = "搜索文本" newWorkbook.ActiveSheet.Range("B2") = "出现次数" newWorkbook.ActiveSheet.Range("A3") = searchText newWorkbook.ActiveSheet.Range("B3") = totalCount '保存并关闭新工作簿 newWorkbook.Save newWorkbook.Close End Sub 这段代码会搜索指定文件夹中的所有Excel文件,遍历每个Excel文件中的所有sheet,并在每个sheet中搜索指定文本。如果文本出现在某个单元格中,则计入搜索结果中。搜索结果会被写入一个新的Excel文件中,每个sheet的搜索结果会单独列出。最后,总的搜索结果会被写入新工作簿的总表中。

最新推荐

大型电力集团财务集中管控平台项目总体规划方案.docx

大型电力集团财务集中管控平台项目总体规划方案.docx

C#课程设计 扫雷游戏.zip

C#课程设计 扫雷游戏

300180华峰超纤财务报告资产负债利润现金流量表企业治理结构股票交易研发创新等1391个指标(2007-2022).xlsx

包含1391个指标,其说明文档参考: https://blog.csdn.net/yushibing717/article/details/136115027 数据来源:基于上市公司公告数据整理 数据期间:从具体上市公司上市那一年开始-2022年度的数据,年度数据 包含各上市公司股票的、多年度的上市公司财务报表资产负债表、上市公司财务报表利润表、上市公司财务报表现金流量表间接法、直接法四表合在一个面板里面,方便比较和分析利用 含各个上市公司股票的、多年度的 偿债能力 披露财务指标 比率结构 经营能力 盈利能力 现金流量分析 风险水平 发展能力 每股指标 相对价值指标 股利分配 11类财务指标分析数据合在一个面板里面,方便比较和分析利用 含上市公司公告的公司治理、股权结构、审计、诉讼等数据 包含1391个指标,如: 股票简称 证券ID 注册具体地址 公司办公地址 办公地址邮政编码 董事会秘书 董秘联系电话 董秘传真 董秘电子邮箱 ..... 货币资金 其中:客户资金存款 结算备付金 其中:客户备付金 .........

300145中金环境财务报告资产负债利润现金流量表企业治理结构股票交易研发创新等1391个指标(2007-2022).xlsx

包含1391个指标,其说明文档参考: https://blog.csdn.net/yushibing717/article/details/136115027 数据来源:基于上市公司公告数据整理 数据期间:从具体上市公司上市那一年开始-2022年度的数据,年度数据 包含各上市公司股票的、多年度的上市公司财务报表资产负债表、上市公司财务报表利润表、上市公司财务报表现金流量表间接法、直接法四表合在一个面板里面,方便比较和分析利用 含各个上市公司股票的、多年度的 偿债能力 披露财务指标 比率结构 经营能力 盈利能力 现金流量分析 风险水平 发展能力 每股指标 相对价值指标 股利分配 11类财务指标分析数据合在一个面板里面,方便比较和分析利用 含上市公司公告的公司治理、股权结构、审计、诉讼等数据 包含1391个指标,如: 股票简称 证券ID 注册具体地址 公司办公地址 办公地址邮政编码 董事会秘书 董秘联系电话 董秘传真 董秘电子邮箱 ..... 货币资金 其中:客户资金存款 结算备付金 其中:客户备付金 .........

MDK 5.39.EXE

MDK5.39 5.39

DAC简介及参考电路PPT学习教案.pptx

DAC简介及参考电路PPT学习教案.pptx

管理建模和仿真的文件

管理Boualem Benatallah引用此版本:布阿利姆·贝纳塔拉。管理建模和仿真。约瑟夫-傅立叶大学-格勒诺布尔第一大学,1996年。法语。NNT:电话:00345357HAL ID:电话:00345357https://theses.hal.science/tel-003453572008年12月9日提交HAL是一个多学科的开放存取档案馆,用于存放和传播科学研究论文,无论它们是否被公开。论文可以来自法国或国外的教学和研究机构,也可以来自公共或私人研究中心。L’archive ouverte pluridisciplinaire

OceanBase数据库简介及原理解析

# 1. OceanBase数据库概述 ## 1.1 OceanBase数据库的发展历程 OceanBase数据库是由阿里巴巴集团自主研发的一款分布式关系型数据库系统,起源于阿里集团的业务需求和技术挑战。自2010年开始研发,经过多年的迭代和优化,OceanBase已经成为阿里巴巴集团重要的核心数据库产品之一。在实际的业务场景中,OceanBase已经被广泛应用于金融、电商、物流等各个领域。 ## 1.2 OceanBase数据库的特点和优势 OceanBase数据库具有以下特点和优势: - **分布式架构**:OceanBase采用多副本分布式架构,可以实现高可用和数据容灾。 -

python的pandas读取excel怎么将excel表里的列从1开始而不是0

在 Pandas 中,数据框的列默认从0开始编号,但我们可以通过自定义函数来进行数据列的转换。可以先将读取的数据框列的第一个值设为1,然后对后续列进行递增处理。 以下是示例代码: ```python import pandas as pd # 读取 Excel 文件 df = pd.read_excel('your_excel_file.xlsx') # 定义函数将列从1开始 def reset_column(x): return str(int(x) + 1) # 应用函数到所有列名 df = df.rename(columns=reset_column) # 打印数据框

第三章薪酬水平、薪酬系统的运行与控制.pptx

第三章薪酬水平、薪酬系统的运行与控制.pptx