vba代出现莫须有错误，都是一个个复制下来的为啥出错呢？

Question

这个是可以完美运行的程序

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 countDict8 As Object
    Dim countDict9 As Object
    Dim countDict10 As Object
    Dim countDict11 As Object
    Dim countDict12 As Object
    Dim countDict13 As Object
    Dim countDict14 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
    Dim result8 As String
    Dim result9 As String
    Dim result10 As String
    Dim result11 As String
    Dim result12 As String
    Dim result13 As String
    Dim result14 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")
    Set countDict8 = CreateObject("Scripting.Dictionary")
    Set countDict9 = CreateObject("Scripting.Dictionary")
    Set countDict10 = CreateObject("Scripting.Dictionary")
    Set countDict11 = CreateObject("Scripting.Dictionary")
    Set countDict12 = CreateObject("Scripting.Dictionary")
    Set countDict13 = CreateObject("Scripting.Dictionary")
    Set countDict14 = 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
            
            For Each keyword In Array("涌泉", "然谷", "太溪", "大钟", "水泉", "照海", "复溜", "交信", "筑宾", "阴谷", "横骨", "大赫", "气穴", "四满", "中注", "肓俞", "商曲", "石关", "阴都", "通谷", "幽门", "步廊", "神封", "灵墟", "神藏", "彧中", "俞府")
                If InStr(1, cell.value, keyword) > 0 Then
                    If countDict8.Exists(keyword) Then
                        countDict8(keyword) = countDict8(keyword) + 1
                    Else
                        countDict8(keyword) = 1
                    End If
                End If
            Next keyword
            
            For Each keyword In Array("天池", "天泉", "曲泽", "郄门", "间使", "内关", "大陵", "劳宫", "中冲")
                If InStr(1, cell.value, keyword) > 0 Then
                    If countDict9.Exists(keyword) Then
                        countDict9(keyword) = countDict9(keyword) + 1
                    Else
                        countDict9(keyword) = 1
                    End If
                End If
            Next keyword
            
            For Each keyword In Array("关冲", "液门", "中渚", "阳池", "外关", "支沟", "会宗", "三阳络", "四渎", "天井", "清冷渊", "消泺", "臑会", "肩髎", "天髎", "天牖", "翳风", "瘈脉", "颅息", "角孙", "耳门", "耳和髎", "丝竹空")
                If InStr(1, cell.value, keyword) > 0 Then
                    If countDict10.Exists(keyword) Then
                        countDict10(keyword) = countDict10(keyword) + 1
                    Else
                        countDict10(keyword) = 1
                    End If
                End If
            Next keyword
            For Each keyword In Array("瞳子髎", "听会", "上关", "颌厌", "悬颅", "悬厘", "曲鬓", "率谷", "天冲", "浮白", "头窍阴", "完骨", "本神", "阳白", "头临泣", "目窗", "正营", "承灵", "脑空", "风池", "肩井", "渊液", "辄筋", "日月", "京门", "带脉", "五枢", "维道", "居髎", "环跳", "风市", "中渎", "膝阳关", "阳陵泉", "阳交", "外丘", "光明", "阳辅", "悬钟", "丘墟", "足临泣", "地五会", "侠溪", "足窍阴")
                If InStr(1, cell.value, keyword) > 0 Then
                    If countDict11.Exists(keyword) Then
                        countDict11(keyword) = countDict11(keyword) + 1
                    Else
                        countDict11(keyword) = 1
                    End If
                End If
            Next keyword
            
            For Each keyword In Array("大敦", "行间", "太冲", "中封", "蠡沟", "中都", "膝关", "曲泉", "阴包", "足五里", "阴廉", "急脉", "章门", "期门")
                If InStr(1, cell.value, keyword) > 0 Then
                    If countDict12.Exists(keyword) Then
                        countDict12(keyword) = countDict12(keyword) + 1
                    Else
                        countDict12(keyword) = 1
                    End If
                End If
            Next keyword
            
            For Each keyword In Array("会阴", "曲骨", "中极", "关元", "石门", "气海", "阴交", "神阙", "水分", "下脘", "建里", "中脘", "上脘", "巨阙", "鸠尾", "中庭", "膻中", "玉堂", "紫宫", "华盖", "璇玑", "天突", "廉泉", "承浆")
                If InStr(1, cell.value, keyword) > 0 Then
                    If countDict13.Exists(keyword) Then
                        countDict13(keyword) = countDict13(keyword) + 1
                    Else
                        countDict13(keyword) = 1
                    End If
                End If
            Next keyword
            
            For Each keyword In Array("长强", "腰俞", "腰阳关", "命门", "悬枢", "脊中", "中枢", "筋缩", "至阳", "灵台", "神道", "身柱", "陶道", "大椎", "哑门", "风府", "脑户", "强间", "后顶", "百会", "前顶", "囟会", "上星", "神庭", "印堂", "素髎", "水沟", "兑端", "龈交")
                If InStr(1, cell.value, keyword) > 0 Then
                    If countDict14.Exists(keyword) Then
                        countDict14(keyword) = countDict14(keyword) + 1
                    Else
                        countDict14(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) ' 移除最后的逗号和空格
    
    For Each keyword In countDict8.keys
        result8 = result8 & keyword & " (" & countDict8(keyword) & "), "
    Next keyword
    result8 = Left(result8, Len(result8) - 2) ' 移除最后的逗号和空格
    
    For Each keyword In countDict9.keys
        result9 = result9 & keyword & " (" & countDict9(keyword) & "), "
    Next keyword
    result9 = Left(result9, Len(result9) - 2) ' 移除最后的逗号和空格
    
    For Each keyword In countDict10.keys
        result10 = result10 & keyword & " (" & countDict10(keyword) & "), "
    Next keyword
    result10 = Left(result10, Len(result10) - 2) ' 移除最后的逗号和空格
    
      For Each keyword In countDict11.keys
        result11 = result11 & keyword & " (" & countDict11(keyword) & "), "
    Next keyword
    result11 = Left(result11, Len(result11) - 2) ' 移除最后的逗号和空格
    
    For Each keyword In countDict12.keys
        result12 = result12 & keyword & " (" & countDict12(keyword) & "), "
    Next keyword
    result12 = Left(result12, Len(result12) - 2) ' 移除最后的逗号和空格
    
    For Each keyword In countDict13.keys
        result13 = result13 & keyword & " (" & countDict13(keyword) & "), "
    Next keyword
    result13 = Left(result13, Len(result13) - 2) ' 移除最后的逗号和空格
    
    For Each keyword In countDict14.keys
        result14 = result14 & keyword & " (" & countDict14(keyword) & "), "
    Next keyword
    result14 = Left(result14, Len(result14) - 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
    ws.Range("E8").value = result8
    ws.Range("E9").value = result9
    ws.Range("E10").value = result10
    ws.Range("E11").value = result11
    ws.Range("E12").value = result12
    ws.Range("E13").value = result13
    ws.Range("E14").value = result14
End Sub

但是当我复制下当前的代码，改了第七个几个汉字后，就报错了

 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

这是报错图片

点调试后显示如图

就很离谱啊
原程序运行的好好的，也是我从ChatGPT好不容易获取一个模板后从1到14一个一个填的啊，这咋就报错呢？

测试文档获取链接：https://wwoh.lanzoue.com/i6B1H0y3oogh

Answer 1

你一点点检查，result7 countDict7 和前面比有没有缺少定义或者写错了。

Answer 2

目测你的数据源有问题吧，一改了数组中的元素，源数据不属于其中了，运行就会报这种错。我是盲猜，如果需要，可以把对应的源数据给我一份，我给你分析一下

Answer 3

• 以下回答由chatgpt基于相关博客总结生成:

  根据提供的信息，我无法准确判断代码出现的错误具体原因，也无法提供更具体的报错信息和复制后的代码。这种情况下，建议您通过以下方式来排查错误： 1.检查修改的第七个汉字是否有误，特别是是否将某个字符误删掉或替换成其他字符。可能的情况包括拼写错误、大小写问题、空格或符号错误等等。

  2.检查修改后的代码是否引入了其他错误，例如语法错误、括号未关闭、变量未声明、重复定义变量等等。可以尝试逐行调试代码，并用“MsgBox”输出调试信息，以帮助查找错误。

  3.检查VBA引用的对象或库文件是否正确，防止出现缺失或版本不匹配的情况。比如有些代码需要引用Microsoft Excel Object Library，如果引用的版本与当前使用的Excel版本不匹配，就会引发错误。

  4.建议将错误信息截图，包括代码和错误提示窗口，以便更好地进行跟踪和排查。

  5.如果以上方法都不能解决问题，建议在网上查找与该问题相关的解决方案，或向VBA开发者社区求助。可能会得到更专业、更全面的帮助。

Answer 4

可以借鉴下

不要一个一个的去判断是否存在窗口，而是直接循环所有窗口，对特定的进行处理，逻辑是：
Sub x()
Dim wb As Workbook
For Each wb In Workbooks
MsgBox wb.Name
If wb.Name = "att01.csv" Or wb.Name = "att02.csv" Or wb.Name = "att03.csv" Then
wb.Activate
'继续处理
End If
Next wb
End Sub