Excel VBA Do While循环内IF语句触发Type Mismatch类型不匹配错误求解

报错核心触发原因 #

触发Type Mismatch错误的逻辑位于IF判断分支中：

• 代码中Range("A1:O26")是26行×15列的多单元格区域，即便通过Offset偏移列位置，该Range对象依然保持固定尺寸的块结构，调用.Value属性时会返回二维Variant数组
• 代码直接将返回的数组类型结果与空字符串""做等值比较，两种数据类型不兼容，直接触发类型不匹配错误。

其他潜在运行风险 #

除核心报错外，现有代码还存在几个会导致运行异常的逻辑问题：

• 提前定义了myrange范围对象但全程未使用，每次判断、赋值都重复调用工作表接口获取相同范围，运行效率极低
• 将多单元格的数组值直接赋值给单个起始单元格时，后续设置Font.Bold的代码仅会作用于粘贴区域的左上角单元格，无法覆盖整块复制的内容
• 硬编码的9999次循环上限没有边界校验，当Offset偏移超出工作表最大列范围时，会触发越界类运行错误
• 原代码中续行符_的位置缺少前置空格，存在语法解析风险

修复后可正常运行的代码 #

Sub practice()
    Dim i As Long
    Dim myrange As Range
    Dim targetBlock As Range
    Dim pasteBase As Range
    
    ' 初始化固定引用对象，避免重复调用工作表接口
    Set myrange = Worksheets("test").Range("A1:O26")
    Set pasteBase = Worksheets("test_table").Range("rest_out")
    
    i = 1
    Do While i <= 9999
        ' 获取当前循环读取的固定尺寸数据块
        Set targetBlock = myrange.Offset(0, i - 1)
        
        ' 统计区域非空单元格数，为0则判定为空块退出循环，规避类型不匹配问题
        If WorksheetFunction.CountA(targetBlock) = 0 Then
            Exit Do
        End If
        
        ' 整块复制源数据到目标位置
        targetBlock.Copy Destination:=pasteBase.Offset((i - 1) * 24, 0)
        ' 匹配源块尺寸设置加粗格式，覆盖全部粘贴内容
        pasteBase.Offset((i - 1) * 24, 0).Resize( _
            targetBlock.Rows.Count, targetBlock.Columns.Count).Font.Bold = True
        
        i = i + 1
    Loop
End Sub

调整说明 #

• 用CountA的统计结果判定区域是否为空，替代原本的多单元格值与字符串直接比较的逻辑，从根源解决类型不匹配问题
• 复用预定义的Range对象，减少重复的对象创建开销
• 采用Range的Copy方法完成块级数据复制，保证值和基础格式的传递一致性
• 格式设置环节通过Resize匹配源数据块的行列尺寸，确保格式应用范围准确

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