VBA之批量进行工作簿及工作表循环查找内容

Mavey__Loo

已于 2025-02-12 10:14:02 修改

阅读量4.1k

点赞数 1

分类专栏： VBA 文章标签： vba

于 2022-05-31 20:17:02 首次发布

本文链接：https://blog.csdn.net/Mavey__/article/details/125072503

版权

VBA 专栏收录该内容

3 篇文章

订阅专栏

本文介绍了如何使用VBA在多个工作簿和工作表中批量循环查找特定内容。通过自定义VBA宏，你可以高效地定位到目标数据，提升Excel数据处理效率。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

SUB SplitRange
    '关闭屏幕刷新
	Application.ScreenUpdating = FALSE
	'禁用事件
	Application.EnableEvents = FALSE
	'禁止显示提示和警告消息
	Application.DisplayAlerts = FALSE
	ThisWorkbook.Worksheets("清单").SELECT
	'声明字符串类型的数组
	DIM STR() AS STRING
	DIM STR1() AS STRING
	'获取当前工作簿中”清单“工作表的第二列的行数
	lastrow = ThisWorkbook.Worksheets("清单").CELLS(ROWS.COUNT,2).END(XLUP).ROW
	'从第三行开始循环
	FOR i = 3 TO lastrow
	
		workbookName = ThisWorkbook.Worksheets("清单").CELLS(i,8).VALUE
		'打开工作簿
		Workbooks.OPEN (workbookName)
		
		lastrow1 = Workbooks(workbookName).Worksheets("清单").CELLS(ROWS.COUNT,2).END(XLUP).ROW
		
		
		'循环工作簿所有工作表 FOR EACH SH IN Workbooks(workbookName).Worksheets
		'工作表不隐藏以及工作表名不为“ATTU“ IF SH.VISIBLE = TRUE AND SH.NAME <> "ATTU" THEN
		FOR j = 3 TO lastrow1
			sheetname1 = Workbooks(workbookName).Worksheets("清单").CELLS(j,7).VALUE
			sheetname2 = Workbooks(workbookName).Worksheets("清单").CELLS(j,7).VALUE
			
			lastrow2 = Workbooks(workbookName).Worksheets(sheetname1).CELLS(ROWS.COUNT,2).END(XLUP).ROW
			
			M = 1
			'清空部分单元格内容 Clear/Delete/ClearContents
			ThisWorkbook.Worksheets("统计").RANGE("A:C").Clear
			FOR k = 5 TO lastrow2
				XUHAO = Workbooks(workbookName).Worksheets(sheetname1).CELLS(k,2).VALUE)
				Q = ""
				'将内容中的回车符替换为换行符
				Strg = REPLACE(Workbooks(workbookName).Worksheets(sheetname1).CELLS(k,7).VALUE,CHR(13),CHR(10))
				IF Strg = "" THEN 
					WW = 1
				ELSE
				    '对字符串进行分割，分割符为换行符
					STR() = SPLIT(Strg,CHR(10))
					'获取数组的边界
					J1 = UBOUND(STR)
					
					FOR l = 0 J1
					    '对数组的内容去除空格处理
						A = TRIM(STR(l)
						Q = " : " & A
						W = REPLACE(Q," : ","")
						'对字符串进行大写处理
						ThisWorkbook.Worksheets("统计").CELLS(M,1)=UCASE(W)
						
						M = M + 1
					NEXT
				END IF
				
			NEXT
			'以第二行第一列为起始位置，扩展1行200列，查找”备注“单元格的列数
			'MATCHCASE区分大小写属性，false为不区分，默认为false
			R1 = Workbooks(workbookName).Worksheets(sheetname1).CELLS(2,1).RESIZE(1,200).FIND("备注",MATCHCASE:=FALSE).COLUMN
			'LOOKAT是是否完全匹配单元格内容属性，XLWHOLE为完全匹配，默认部分匹配
			SET RNG1 = ThisWorkbook.Worksheets("统计").CELLS(1,1).RESIZE(10000,3).FIND("SJAJHDD",LOOKAT:=XLWHOLE)
			
			IF RNG1 IS NOTHING THEN
				DD = 1
			ELSE 
				ThisWorkbook.Worksheets("统计").CELLS(1,10) = "QQQQ"
			END IF
		NEXT
		'工作簿保存
		Workbooks(workbookName).SAVE
		'工作簿关闭
		Workbooks(workbookName).CLOSE
		
	NEXT
	
	
	ThisWorkbook.Worksheets("清单").SELECT
	Application.EnableEvents = FALSE
	Application.ScreenUpdating = FALSE
	
	MSGBOX "复制分割完成" & VBLF & DD , VBINFORMATION,"友情提示"
	
END SUB