为什么同样的代码,把1那部分括号里的复制到2括号里就能运行,现在这样就不能运行,报错呢?格式也对,也没有符号错误啊,汉字也不生僻啊
源代码如下:
Sub CountKeywords()
Dim ws As Worksheet
Dim lastRow As Long
Dim cell As Range
Dim countDict1 As Object
Dim countDict2 As Object
Dim countDict3 As Object
Dim countDict4 As Object
Dim countDict5 As Object
Dim countDict6 As Object
Dim countDict7 As Object
Dim keyword As Variant
Dim result1 As String
Dim result2 As String
Dim result3 As String
Dim result4 As String
Dim result5 As String
Dim result6 As String
Dim result7 As String
Set ws = ThisWorkbook.Worksheets("Sheet1") ' 替换为您的工作表名称
lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row
Set countDict1 = CreateObject("Scripting.Dictionary")
Set countDict2 = CreateObject("Scripting.Dictionary")
Set countDict3 = CreateObject("Scripting.Dictionary")
Set countDict4 = CreateObject("Scripting.Dictionary")
Set countDict5 = CreateObject("Scripting.Dictionary")
Set countDict6 = CreateObject("Scripting.Dictionary")
Set countDict7 = CreateObject("Scripting.Dictionary")
' 遍历A列单元格
For Each cell In ws.Range("A1:A" & lastRow)
If cell.value <> "" Then
' 检查单元格内容是否匹配关键词
For Each keyword In Array("列缺", "偏历", "丰隆", "公孙", "通里", "支正", "飞扬", "大钟", "内关", "外关", "光明", "蠡沟", "鸩尾", "长强")
If InStr(1, cell.value, keyword) > 0 Then
' 更新关键词频次计数
If countDict1.Exists(keyword) Then '络穴
countDict1(keyword) = countDict1(keyword) + 1
Else
countDict1(keyword) = 1
End If
End If
Next keyword
For Each keyword In Array("太渊", "合谷", "冲阳", "太白", "神门", "腕骨", "京骨", "太溪", "大陵", "阳池", "丘墟", "太冲")
If InStr(1, cell.value, keyword) > 0 Then
If countDict2.Exists(keyword) Then '原穴
countDict2(keyword) = countDict2(keyword) + 1
Else
countDict2(keyword) = 1
End If
End If
Next keyword
For Each keyword In Array("上巨虚", "足三里", "下巨虚", "委中", "委阳", "阳陵泉")
If InStr(1, cell.value, keyword) > 0 Then
If countDict3.Exists(keyword) Then '下合穴
countDict3(keyword) = countDict3(keyword) + 1
Else
countDict3(keyword) = 1
End If
End If
Next keyword
For Each keyword In Array("公孙", "内关", "足临泣", "外关", "后溪", "申脉", "列缺", "照海")
If InStr(1, cell.value, keyword) > 0 Then
If countDict4.Exists(keyword) Then '八脉交会穴
countDict4(keyword) = countDict4(keyword) + 1
Else
countDict4(keyword) = 1
End If
End If
Next keyword
For Each keyword In Array("中脘", "章门", "阳陵泉", "悬钟", "大杼", "膻中", "膈俞", "太渊")
If InStr(1, cell.value, keyword) > 0 Then
If countDict5.Exists(keyword) Then '八会穴
countDict5(keyword) = countDict5(keyword) + 1
Else
countDict5(keyword) = 1
End If
End If
Next keyword
For Each keyword In Array("中府", "天枢", "中脘", "章门", "巨阙", "关元", "中极", "京门", "膻中", "石门", "日月", "期门")
If InStr(1, cell.value, keyword) > 0 Then
If countDict6.Exists(keyword) Then '募穴
countDict6(keyword) = countDict6(keyword) + 1
Else
countDict6(keyword) = 1
End If
End If
Next keyword
For Each keyword In Array("孔最", "温溜", "梁丘", "地机", "阴郄", "养老", "金门", "水泉", "郄门", "会宗", "外丘", "中都", "阳交", "筑宾", "跗阳", "交信")
If InStr(1, cell.value, keyword) > 0 Then
If countDict7.Exists(keyword) Then
countDict7(keyword) = countDict7(keyword) + 1
Else
countDict7(keyword) = 1
End If
End If
Next keyword
End If
Next cell
' 生成结果字符串
For Each keyword In countDict1.keys
result1 = result1 & keyword & " (" & countDict1(keyword) & "), "
Next keyword
result1 = Left(result1, Len(result1) - 2) ' 移除最后的逗号和空格
For Each keyword In countDict2.keys
result2 = result2 & keyword & " (" & countDict2(keyword) & "), "
Next keyword
result2 = Left(result2, Len(result2) - 2) ' 移除最后的逗号和空格
For Each keyword In countDict3.keys
result3 = result3 & keyword & " (" & countDict3(keyword) & "), "
Next keyword
result3 = Left(result3, Len(result3) - 2) ' 移除最后的逗号和空格
For Each keyword In countDict4.keys
result4 = result4 & keyword & " (" & countDict4(keyword) & "), "
Next keyword
result4 = Left(result4, Len(result4) - 2) ' 移除最后的逗号和空格
For Each keyword In countDict5.keys
result5 = result5 & keyword & " (" & countDict5(keyword) & "), "
Next keyword
result5 = Left(result5, Len(result5) - 2) ' 移除最后的逗号和空格
For Each keyword In countDict6.keys
result6 = result6 & keyword & " (" & countDict6(keyword) & "), "
Next keyword
result6 = Left(result6, Len(result6) - 2) ' 移除最后的逗号和空格
For Each keyword In countDict7.keys
result7 = result7 & keyword & " (" & countDict7(keyword) & "), "
Next keyword
result7 = Left(result7, Len(result7) - 2) ' 移除最后的逗号和空格
' 将结果输入到E1、E2、E3单元格
ws.Range("E1").value = result1
ws.Range("E2").value = result2
ws.Range("E3").value = result3
ws.Range("E4").value = result4
ws.Range("E5").value = result5
ws.Range("E6").value = result6
ws.Range("E7").value = result7
End Sub