请写一段VBA代码,帮我解决以下问题:我在桌面有一个文件夹名为“新建文件夹检索”,这个文件夹中有多个exl表格,每个表格中有多个sheet,请在文件夹中的所有sheet中检索文本“特瑞普利单抗”,并统计文本“特瑞普利单抗”出现的次数,将结果写入到一个新的exl文档中,该文档创建在桌面,命名为“新建文件夹检索结果”。注意,“特瑞普利单抗”可能是单元格中数据的一部分片段,这样也计入次数。结果的书写方式是每个sheet分别列出。
时间: 2024-02-11 12:05:14 浏览: 95
以下是VBA代码实现您的需求:
```
Sub SearchAndCount()
Dim searchFolder As String '要搜索的文件夹路径
Dim resultFile As String '结果文件路径
Dim searchText As String '待搜索的文本
Dim count As Long '计数器
Dim wb As Workbook '工作簿对象
Dim ws As Worksheet '工作表对象
Dim newWb As Workbook '新建的工作簿对象
Dim newWs As Worksheet '新建的工作表对象
Dim row As Long '行计数器
'设置要搜索的文件夹路径和待搜索的文本
searchFolder = "C:\Users\Username\Desktop\新建文件夹检索\"
resultFile = "C:\Users\Username\Desktop\新建文件夹检索结果.xlsx"
searchText = "特瑞普利单抗"
'创建新的工作簿和工作表
Set newWb = Workbooks.Add
Set newWs = newWb.Sheets(1)
'在新建的工作表中写入表头
newWs.Range("A1").Value = "Sheet名称"
newWs.Range("B1").Value = "计数"
'遍历文件夹中的所有excel文件
Dim file As String
file = Dir(searchFolder & "*.xls*")
Do Until file = ""
Set wb = Workbooks.Open(searchFolder & file) '打开文件
For Each ws In wb.Sheets '遍历所有工作表
count = 0 '重置计数器
For Each cell In ws.UsedRange '遍历工作表中所有单元格
If InStr(1, cell.Value, searchText, vbTextCompare) > 0 Then '如果单元格中包含待搜索的文本
count = count + 1 '计数器加1
End If
Next cell
'将结果写入新建的工作表中
row = newWs.Cells(Rows.Count, 1).End(xlUp).Row + 1 '获取下一个空行
newWs.Cells(row, 1).Value = ws.Name '写入工作表名称
newWs.Cells(row, 2).Value = count '写入计数结果
Next ws
wb.Close False '关闭文件,不保存
file = Dir '获取下一个文件
Loop
'保存并关闭新建的工作簿
newWb.SaveAs resultFile
newWb.Close
End Sub
```
您只需要将代码中的文件夹路径和待搜索的文本替换成您的实际路径和文本,然后运行该宏即可实现您的需求。注意,如果您的电脑中没有安装Excel软件,则无法运行该代码。
阅读全文