Sub XO()
Dim strPath As String
strPath = ThisWorkbook.Path
Call getExcelFile0(strPath)
End Sub
Sub getExcelFile0(sFolderPath As String)
On Error Resume Next
Dim f As String
Dim file() As String
x = 2
wj = 2
k = 2
ReDim file(1)
file(1) = sFolderPath & "\"
lj = sFolderPath
'Stop
f = Dir(file(1) & "*.xlsx") '通配符*.*表示所有文件,*.xlsx Excel文件
Do Until f = ""
Cells(2, x).Hyperlinks.Add Anchor:=Cells(2, x), Address:=file(i) & f, TextToDisplay:=f
Temp = lj & "\" & f '外部文件路径
Dim wb As Workbook
Set wb = GetObject(Temp)
For Each sh In wb.Worksheets '数组
sh.Select
sheetname = sh.Name
Cells(3, wj).Value = f
Cells(4, k).Value = sheetname
findx = "*" & Cells(1, 1) & "*"
With sh.Range("a1:z500")
'使用通配符查找
h = 5
Set c = .Find(findx, LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
'在这里写根据第一个找到的单元格进行的操作
Do
'在这里写对根据后续找到的单元格进行的操作
' Debug.Print c.Row, c.Column
' c.Font.Color = vbRed
Set c = .FindNext(c)
r = c.Row '返回行
cl = c.Column '返回列
x1 = c.Address
Cells(h, wj) = x1
h = h + 1
Cells(h, wj) = c.Value
h = h + 1
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With
' wb.Close savechanges:=False
wj = wj + 1
k = k + 1
Next
x = x + 1
f = Dir
Loop
End Sub