做百科的网站,注销公司需要多少钱,珠海网站制作推荐,招商加盟网站建设目的需求如下#xff1a;
B列为产品名为合并单元格#xff0c;C列为供应商名#xff0c;G、H列为金额数据#xff1b;数据源放在同一个文件夹内#xff0c;B列产品名来源于工作薄名称中间的字符串#xff0c;C列供应商名来源于工作薄中的sheet名#xff1b;G、H列金额数据来…需求如下
B列为产品名为合并单元格C列为供应商名G、H列为金额数据数据源放在同一个文件夹内B列产品名来源于工作薄名称中间的字符串C列供应商名来源于工作薄中的sheet名G、H列金额数据来源于工作薄中sheet中固定单元格P25:Q25的数值根据B列产品名自动打开对应的工作薄并按照C列供应商名对应的sheet把P25:Q25的数据自动复制到G、H列
VBA执行效果视频 数据自动汇总 Sub GetDataFromSourceWorkbooks()Dim targetWorkbook As WorkbookDim targetWorksheet As WorksheetDim currentSheetName As StringDim sourceFolder As StringDim productColumn As StringDim supplierColumn As StringDim amount1Column As StringDim amount2Column As StringDim cell As RangeDim product As StringDim supplier As StringDim sourceFileName As StringDim sourceWorkbook As WorkbookDim sourceWorksheet As WorksheetDim amount1 As DoubleDim amount2 As Double Replace with your specific column lettersproductColumn BsupplierColumn Camount1Column Gamount2Column H Replace with your target workbook pathSet targetWorkbook ThisWorkbook Set target worksheet nameSet targetWorksheet targetWorkbook.ActiveSheet 假设目标文件中的主工作表为活动工作表Set currentSheetName ActiveSheet.NameSet targetWorksheet targetWorkbook.Worksheets(currentSheetName) Input the folder path containing the source workbookssourceFolder InputBox(请输入目标文件路径, 目标文件路径输入)sourceFolder sourceFolder \sourceFolder C:\Users\18703\Desktop\自动化\数据\爱家影视包\If sourceFolder ThenMsgBox 未输入目标文件路径。操作已取消。, vbExclamationExit SubEnd If禁止刷新屏幕Application.ScreenUpdating FalseDim firstRow As StringDim lastRow As StringfirstRow 2 定义数值区域开始的行数lastRow targetWorksheet.Cells(targetWorksheet.Rows.Count, A).End(xlUp).Row 查找数值区域最后一行开始循环找对应目标工作表对应工作薄中sheet中所需要的单元格数据For Each cell In targetWorksheet.Range(productColumn firstRow : productColumn lastRow)产品列值和供应商值product cell.MergeArea.Cells(1, 1).Value Get the value of the first cell in the merged rangesupplier cell.Offset(0, 1).Value数据源excel表的所有路径sourceFileName Dir(sourceFolder * product *.xls*)若数据源不为空或数据源不是目标工作表就打开对应的工作薄中的sheetIf sourceFileName And sourceFileName targetWorkbook.Name ThenSet sourceWorkbook Workbooks.Open(sourceFolder sourceFileName)Set sourceWorksheet sourceWorkbook.Worksheets(supplier) 确认所需要的数据amount1 sourceWorksheet.Range(P25).Valueamount2 sourceWorksheet.Range(Q25).ValuesourceWorkbook.Close False 数据源选择不保存关闭 Update the target worksheet with the values from the source workbookcell.Offset(0, 5).Value amount1 Amount 1 columncell.Offset(0, 6).Value amount2 Amount 2 columnElsecell.Offset(0, 5).Value Not Found Amount 1 columncell.Offset(0, 6).Value Not Found Amount 2 columnEnd IfNext cell禁止刷新屏幕Application.ScreenUpdating TrueMsgBox 数据获取完成请确认 目标工作表保存但不关闭确认无误后可手动关闭targetWorkbook.Save Save changesEnd Sub
