请写一段VBA代码,帮我解决以下问题:我有一个exl表格,表格中有多个sheet,请在所有sheet中检索“清开灵”,并统计“清开灵”出现的次数,将结果写入到sheet2中。
时间: 2024-02-10 18:10:53 浏览: 36
以下是可以实现你要求的VBA代码:
```
Sub CountQKL()
Dim ws As Worksheet
Dim count As Long
Dim summaryWs As Worksheet
Set summaryWs = ThisWorkbook.Sheets("Sheet2") '将结果写入到Sheet2
summaryWs.Cells.ClearContents '清空原有数据
For Each ws In ThisWorkbook.Worksheets '循环遍历所有工作表
count = Application.WorksheetFunction.CountIf(ws.UsedRange, "清开灵") '统计“清开灵”出现的次数
summaryWs.Range("A" & summaryWs.Rows.Count).End(xlUp).Offset(1, 0).Value = ws.Name '将工作表名称写入结果表格中
summaryWs.Range("B" & summaryWs.Rows.Count).End(xlUp).Offset(1, 0).Value = count '将“清开灵”出现的次数写入结果表格中
Next ws
End Sub
```
你可以将以上代码复制到VBA编辑器中,然后运行这个宏,就可以在Sheet2中看到所有工作表中“清开灵”出现的次数了。
相关问题
请写一段VBA代码,帮我解决以下问题:我有一个exl表格,表格中有多个sheet,请在所有sheet中检索文本“特瑞普利单抗”,并统计文本“特瑞普利单抗”出现的次数,将结果写入到sheet2中。
好的,以下是可以解决你的问题的VBA代码:
```
Sub FindAndCount()
Dim ws As Worksheet, ws2 As Worksheet
Dim count As Integer
Dim i As Integer, j As Integer
Set ws2 = ThisWorkbook.Sheets("Sheet2") '将结果写入Sheet2
ws2.Range("A1").Value = "Sheet Name"
ws2.Range("B1").Value = "Count"
i = 2 '从第二行开始写入结果
For Each ws In ThisWorkbook.Worksheets
count = 0 '每个sheet的计数器初始化
For j = 1 To ws.UsedRange.Rows.Count '遍历每一行
If InStr(1, ws.Cells(j, 1).Value, "特瑞普利单抗") > 0 Then '检索文本
count = count + 1 '计数器加1
End If
Next j
ws2.Cells(i, 1).Value = ws.Name '写入sheet名
ws2.Cells(i, 2).Value = count '写入计数结果
i = i + 1 '下一行
Next ws
End Sub
```
这段代码会遍历所有的sheet,检索文本“特瑞普利单抗”,并统计出现的次数,最终将结果写入到sheet2中。你可以将该代码复制到VBA编辑器中,然后按F5运行即可。
请写一段VBA代码,帮我解决以下问题:我有一个exl表格,表格中有一个表叫sheet1,sheet1中有两列数据,第一列叫“hospitalID”,第二列叫“tag”。“医院ID”这列数据有重复,对应“tag”中的多个值。请将“hospitalID”去除重复,“tag”中的多个值合并到一个单元格中,呈现形式为“x+y+z”的形式。将新产生的数据写入到sheet2中。
以下是VBA代码的实现:
```VBA
Sub combineTags()
Dim lastRow As Long, i As Long
Dim dict As Object, key As Variant
Dim arr() As String
'获取sheet1的最后一行
lastRow = Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
'创建字典对象
Set dict = CreateObject("Scripting.Dictionary")
'遍历sheet1中的数据
For i = 2 To lastRow
If Not dict.exists(Worksheets("sheet1").Range("A" & i).Value) Then
'将医院ID添加到字典中
dict.Add Worksheets("sheet1").Range("A" & i).Value, Worksheets("sheet1").Range("B" & i).Value
Else
'将tag合并到已存在的医院ID对应的值中
dict(Worksheets("sheet1").Range("A" & i).Value) = dict(Worksheets("sheet1").Range("A" & i).Value) & "+" & Worksheets("sheet1").Range("B" & i).Value
End If
Next i
'将结果写入sheet2
Worksheets("sheet2").Range("A1").Value = "hospitalID"
Worksheets("sheet2").Range("B1").Value = "tag"
i = 2
For Each key In dict.keys
Worksheets("sheet2").Range("A" & i).Value = key
arr = Split(dict(key), "+")
Worksheets("sheet2").Range("B" & i).Value = Join(arr, "+")
i = i + 1
Next key
End Sub
```
使用方法:
1. 将上述代码复制到一个新的VBA模块中;
2. 打开需要处理的Excel表格,按下Alt+F8打开宏,运行"combineTags"宏即可;
3. 处理结果将会写入到sheet2中。
注意:代码中假设sheet2已经存在,如果sheet2不存在,需要先新建一个sheet2。
相关推荐
![pdf](https://img-home.csdnimg.cn/images/20210720083512.png)
![doc](https://img-home.csdnimg.cn/images/20210720083327.png)
![](https://csdnimg.cn/download_wenku/file_type_ask_c1.png)
![](https://csdnimg.cn/download_wenku/file_type_ask_c1.png)
![](https://csdnimg.cn/download_wenku/file_type_ask_c1.png)
![xlsm](https://img-home.csdnimg.cn/images/20210720083646.png)
![xlsm](https://img-home.csdnimg.cn/images/20210720083646.png)
![pdf](https://img-home.csdnimg.cn/images/20210720083512.png)
![txt](https://img-home.csdnimg.cn/images/20210720083642.png)
![zip](https://img-home.csdnimg.cn/images/20210720083736.png)
![whl](https://img-home.csdnimg.cn/images/20210720083646.png)
![zip](https://img-home.csdnimg.cn/images/20210720083736.png)