源文件为每月得财务报表，查找值所在得单元格位置、表页结构和表页名称相同。
局限和特点目标文件和源文件必须在同一个文件夹内
设置条件，指定值和参数，如表页名称，目标值名称，目标值得单元格地址
创建2个表页，条件表和结果表，结果表用来存放提取得数据
条件表
结果表表头
程序Private Sub CommandButton1_Click()Dim start As Doublestart = Timer '设置计时器Dim myfile, mypath, wb '声明变量Application.ScreenUpdating = False '关闭屏幕更新'预设定义Sheets("结果表").UsedRange.ClearR1 = Sheets("条件表").Range("B5").CurrentRegion.Rows.Count - 1 'b5单元格CTRL+A得区域得行数-1Sheets("条件表").Range("B5").Resize(R1, 1).CopySheets("结果表").Range("B1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True '转置R2 = Sheets("条件表").Range("C2")'预设定义执行完毕mypath = ThisWorkbook.Pathmyfile = Dir(mypath & "\*.xls*") '遍历当前文件夹内所有xls*文件N1 = 1 'N1为J结果表中行序号,和N1+1配合使用，放到哪个循环外Do While myfile <> ""If myfile <> ThisWorkbook.Name ThenSet wb = GetObject(mypath & "\" & myfile) 'wb为工作簿 For I = 1 To wb.Sheets.Count On Error Resume Next '报错跳过 If wb.Sheets(I).Name = R2 Then Sheets("结果表").Range("A1").Offset(N1, 0) = wb.Name For J = 1 To R1 R3 = Sheets("条件表").Range("C5").Offset(J - 1, 0) Sheets("结果表").Range("A1").Offset(N1, J) = wb.Sheets(R2).Range(R3) Next J End If Next I'主体程序执行完毕wb.Close FalseN1 = N1 + 1End Ifmyfile = DirLoopApplication.ScreenUpdating = TrueMsgBox "运行程序使用" & Format(Timer - start, "0.00") & "秒"End Sub
