VBA代码高亮循环段出现Type 13类型不匹配错误求助

运行Send_Email VBA宏时，CC邮件列表循环代码段触发Error 13（类型不匹配）错误，尝试将相关变量定义为Variant或Integer后问题仍未解决，完整代码如下：

Sub Send_Email()

Dim outApp As Object
Dim outMail As Object
Dim ws As Worksheet
Dim Body As String, Rng As Range

Dim ccEmailList As String
Dim i As Variant
Dim toEmailList As String
Dim j As Variant
Dim r As Variant

Set ws = ActiveSheet

Set outApp = CreateObject("Outlook.Application")
Set outMail = outApp.CreateItem(0)

Body = "Good afternoon, <br><br>Please find below the details of today's activity for your NCIB: <br><br> You bought: <b>" & Range("C7").Text & Range("D7") & Range("E7") & "$" & Range("F7") & _
        "</b><br>Settlement Date: <b>" & Range("C8").Text & "</b><br>Daily VWAP: <b>" & Range("C9").Text & "</b><br>Commission: <b>$" & Range("C10") & _
        "</b><br>Net CAD Amount: <b>" & Range("C11").Text & "</b><br><br>Thanks,"

Worksheets("Issuer data").Activate
Set ws = ActiveSheet

ccEmailList = ""
i = 23
r = Range("A1").Value
    
' 触发错误的CC邮件列表循环段
Do While ws.Cells(i, r) <> ""
    ccEmailList = ccEmailList & ws.Cells(i, r) & ";"
    i = i + 1
Loop

toEmailList = ""
j = 8
'Loop to create the to emailing list
Do While ws.Cells(j, r) <> ""
    toEmailList = toEmailList & ws.Cells(j, r) & ";"
    j = j + 1
Loop

Worksheets("Email generator").Activate

outMail.Display
outMail.To = toEmailList
outMail.CC = ccEmailList
outMail.BCC = ""
outMail.Subject = Cells(4, 2)
outMail.htmlbody = Body
   

End Sub

错误原因分析 #

Error 13（类型不匹配）的核心触发点有两个：

• r = Range("A1").Value 获取的值非法：如果A1单元格是文本（非合法列名）、空值或错误值，ws.Cells(i, r)的列参数无法被识别为有效索引，导致类型不匹配。
• 目标单元格存在错误值：如果ws.Cells(i, r)的内容是#N/A、#VALUE!这类错误值，直接和空字符串""比较时，会触发类型不匹配。

解决方案 #

1. 校验列索引r的有效性 #

确保r是合法的列索引或列名，添加校验逻辑：

r = Range("A1").Value
' 校验并转换r为有效列索引
If Not IsNumeric(r) Then
    On Error Resume Next
    r = Columns(r).Column ' 将列名（如"A"）转换为列索引
    On Error GoTo 0
    If IsError(r) Then
        MsgBox "A1单元格的值不是合法的列索引或列名", vbExclamation
        Exit Sub
    End If
End If
' 确保列索引在有效范围内
If r < 1 Or r > ws.Columns.Count Then
    MsgBox "列索引超出工作表有效范围", vbExclamation
    Exit Sub
End If

2. 处理单元格错误值 #

循环时先判断单元格是否为错误值，再进行空值比较：

'Loop to create the cc emailing list
Do While Not IsError(ws.Cells(i, r).Value) And ws.Cells(i, r).Value <> ""
    ccEmailList = ccEmailList & ws.Cells(i, r).Value & ";"
    i = i + 1
Loop

额外优化点 #

• 避免使用Activate切换工作表，直接通过对象引用：Set ws = Worksheets("Issuer data")，减少ActiveSheet带来的不确定性。
• 将变量i、j、r定义为Long（避免Integer的范围限制），更规范：Dim i As Long, j As Long, r As Long。
• 宏结束后清理Outlook对象，避免内存泄漏：

Set outMail = Nothing
Set outApp = Nothing

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