如何跨工作簿查询?
思路:打开文件夹,打开文件,打开工作表,在单元格查询,查询到结果复制到相应位置,查询不到结果则给出Msgbox提示。
代码:
'跨工作簿查询员工档案
Private Sub CommandButton1_Click()
On Error Resume Next
Dim 姓名 As String, dz As String, str As String, n As Long
Dim wb As Workbook, sh As Worksheet, rng As Range
姓名 = ThisWorkbook.Sheets("查询").[C4] '查询界面姓名单元格
dz = "E:\库管办公资料【勿删】\芙蓉楼\其他\VBA实例\跨工作簿查询\员工档案\" '员工档案文件路径
'清空查询界面数据
With ThisWorkbook.Sheets("查询")
.[C5] = "" '清空店名
.[E5] = "" '清空部门
.[E4] = "" '清空性别
.[C6] = "" '清空职务
.[E6] = "" '清空入职时间
End With
'遍历工作簿
str = Dir(dz)
Do While str <> ""
Set wb = Workbooks.Open(dz & str) '打开遍历到的工作簿
For Each sh In wb.Sheets '循环工作表
n = Cells(Rows.Count, 2).End(xlUp).Row '获取打开工作表的最大行
For Each rng In sh.Range("B2:B" & n) '循环工作表B列单元格
If rng = 姓名 Then '当查询到员工姓名时
With ThisWorkbook.Sheets("查询")
.[C5] = Left(wb.Name, 3) '店名
.[E5] = sh.Name '部门
.[E4] = rng.Offset(0, 1) '姓名
.[C6] = rng.Offset(0, 2) '性别
.[E6] = Format(rng.Offset(0, 3), "yyyy/mm/dd") '入职日期
wb.Close '关闭工作簿
End '查询到结果则退出循环
End With
End If
Next rng
Next sh
wb.Close '关闭没查询到结果的工作簿
str = Dir
Loop
MsgBox "未查询到员工信息!", vbCritical, "错误!"
End Sub