Excel VBA读取工作表区域为关键词数组报运行时错误13类型不匹配

• 现有Excel宏实现逻辑：从所有批注中提取指定关键词，为匹配到的关键词标记颜色后，将对应内容分类归集到专属工作表标签页中。
• 原有实现逻辑中所有关键词均硬编码写入宏代码内部，为方便所有用户按需自定义关键词配置，需修改宏逻辑，改为读取Excel工作表中存储的关键词列表作为数组参数，修改关键词数组赋值代码后出现运行时报错。

运行时错误13：类型不匹配（runtime error 13, Type mismatch）
点击调试按钮后，报错行被黄色高亮标记，报错截图如下：

原Satellite分类可正常运行的硬编码关键词赋值代码 #

KeyW = Array("Satellite", "image", "blacks out", "resolution")

修改后触发报错的单元格读取代码 #

KeyW = Array(Worksheets("MAIN").Range("N5:N15"))

完整相关VBA代码 #

Sub sort()
   
   Dim KeyW()
   Dim cnt_Rows As Long, cnt_Columns As Long, curr_Row As Long, i As Long, x As Long

   Application.Calculation = xlCalculationManual
   Application.ScreenUpdating = False
   
   Sheets(Array("Television", "Satellite", "News", "Sports", "Movies", "Key2", "Key3", "Error", "Commercial", "Key4", "TV", "Key5", "Key6", "Signal", "Key1", "Key7", "Design", "Hardware")).Select

Satellite:
   
   KeyW = Array("Satellite", "image", "blacks out", "resolution")
   
   KeyWLen = UBound(KeyW, 1)

   j = 2

   For i = 0 To KeyWLen

         With Worksheets(1).Range("c4:e7000")
         Set c = .Find(KeyW(i), LookIn:=xlValues, LookAt:=xlPart)
         If Not c Is Nothing Then
            firstAddress = c.Address
            Do
               Sheets("Satellite").Range("b" & j).Value = Worksheets(1).Range("a" & c.Row).Value
               Worksheets(1).Range(c.Address).Copy
               Sheets("Satellite").Activate
               Range("a" & j).Select
               Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
                  , SkipBlanks:=False, Transpose:=False
                  
               Range("a" & j).Select
               WordPos = 1
               StartPos = 1
               SearchStr = KeyW(i)
               While WordPos <> 0
                  WordPos = InStr(StartPos + 1, Range("a" & j).Value, SearchStr, 1)
                  If WordPos > 0 _
                  Then
                     With ActiveCell.Characters(Start:=WordPos, Length:=Len(SearchStr)).Font
                          .FontStyle = "Bold"
                          .Color = -16727809
                     End With
                     StartPos = WordPos
                  End If
               Wend
               
               Worksheets(1).Activate
               j = j + 1
               Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
         End If
      End With
   Next i

• 多单元格区域Range("N5:N15")直接取值返回的是二维数组，额外在外层套Array()函数后，相当于把整个二维数组作为单个元素存入KeyW数组，后续循环调用KeyW(i)时取到的不是字符串类型的关键词，而是Variant类型的数组对象，传入.Find()方法作为查找参数时类型不符合要求，直接触发类型不匹配错误。
• 原硬编码Array("Satellite", "image", "blacks out", "resolution")生成的是下标从0开始的一维字符串数组，和修改后嵌套二维数组的结构完全不兼容。

1. 删除Satellite行标签下原有的硬编码KeyW赋值行，替换为以下代码：

' 读取MAIN工作表N5:N15区域的关键词，过滤空值后生成和原结构一致的一维数组
Dim cell As Range
Dim tempArr As Variant
Dim kwCount As Long
kwCount = WorksheetFunction.CountA(Worksheets("MAIN").Range("N5:N15"))
ReDim KeyW(0 To kwCount - 1)
kwCount = 0
For Each cell In Worksheets("MAIN").Range("N5:N15")
    If Trim(cell.Value) <> "" Then
        KeyW(kwCount) = Trim(cell.Value)
        kwCount = kwCount + 1
    End If
Next

2. 上述代码生成的KeyW数组和原硬编码数组结构完全一致，后续的数组长度计算、关键词查找、内容标色、分类归集逻辑无需任何改动即可正常运行。
3. 后续如果需要调整关键词存储区域，仅需修改代码中对应的单元格范围即可，不需要改动其他业务逻辑。

内容的提问来源于stack exchange，提问作者Asar