VBA循环中条件函数触发1004应用/对象定义错误求助

你遇到的1004运行时错误，核心问题出在WorksheetFunction.Match的特性上：当这个函数找不到匹配项时，它不会返回一个可被IsError检测的错误值，而是直接抛出运行时错误——这就导致你的判断逻辑还没执行，就触发了报错。

下面给你两种可行的修复方案，同时优化代码里的其他潜在问题：

方案1：改用Application.Match替代WorksheetFunction.Match #

Application.Match的行为更友好：找不到匹配项时，它会返回一个错误值（而非直接报错），这样IsError就能正常工作了。

修改关键代码段如下：

If IsError(Application.Match(SW, qrycolvaly, 0)) = True Then
    performed(i) = SW
End If

方案2：使用错误捕获机制 #

如果你坚持用WorksheetFunction.Match，可以通过错误捕获来处理找不到匹配的场景：

On Error Resume Next ' 开启错误捕获
WorksheetFunction.Match(SW, qrycolvaly, 0)
If Err.Number <> 0 Then ' 判断是否触发了找不到匹配的错误
    performed(i) = SW
End If
On Error GoTo 0 ' 关闭错误捕获，恢复默认错误处理

额外的代码优化建议 #

除了修复错误，你的代码还有几个可以优化的点，避免后续问题：

• 动态获取匹配范围：原代码用w3.Range("C1").End(xlDown)如果C1下方没有数据，会直接选中到工作表最后一行，建议改成更可靠的动态范围：

  Dim lastRow As Long
  lastRow = w3.Cells(w3.Rows.Count, "C").End(xlUp).Row
  Set qrycolvaly = w3.Range("C1:C" & lastRow)
  

• 避免空值写入：原代码循环200次都会往工作表1写入，哪怕performed(i)是空值。可以先收集所有不匹配的值，再一次性写入：

  ' 替换原有的循环逻辑
  Dim matchNotFound As Collection
  Set matchNotFound = New Collection
  
  For i = 2 To w2.Cells(w2.Rows.Count, "C").End(xlUp).Row ' 动态遍历工作表2的有效行
      SW = w2.Cells(i, 3).Value
      If SW <> "" Then ' 跳过空单元格
          If IsError(Application.Match(SW, qrycolvaly, 0)) Then
              matchNotFound.Add SW
          End If
      End If
  Next i
  
  ' 一次性写入到工作表1
  If matchNotFound.Count > 0 Then
      startcell.Resize(matchNotFound.Count, 1).Value = Application.Transpose(matchNotFound)
  End If
  

完整修复后的代码 #

Sub sortdata()
    Dim i As Integer
    Dim w2 As Worksheet
    Dim w1 As Worksheet
    Dim w3 As Worksheet
    Dim SW As String
    Dim qrycolvaly As Range
    Dim startcell As Range
    Dim matchNotFound As Collection
    Dim lastRowW2 As Long, lastRowW3 As Long
    
    Set w2 = ThisWorkbook.Worksheets(2)
    Set w1 = ThisWorkbook.Worksheets(1)
    Set w3 = ThisWorkbook.Worksheets(3)
    Set startcell = w1.Range("B9")
    Set matchNotFound = New Collection
    
    ' 动态获取工作表3的C列有效数据范围
    lastRowW3 = w3.Cells(w3.Rows.Count, "C").End(xlUp).Row
    Set qrycolvaly = w3.Range("C1:C" & lastRowW3)
    
    ' 遍历工作表2的C列有效数据，收集不匹配的值
    lastRowW2 = w2.Cells(w2.Rows.Count, "C").End(xlUp).Row
    For i = 2 To lastRowW2
        SW = w2.Cells(i, 3).Value
        If SW <> "" Then
            If IsError(Application.Match(SW, qrycolvaly, 0)) Then
                matchNotFound.Add SW
            End If
        End If
    Next i
    
    ' 将收集到的不匹配值写入工作表1
    If matchNotFound.Count > 0 Then
        startcell.Resize(matchNotFound.Count, 1).Value = Application.Transpose(matchNotFound)
    End If
End Sub

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