VBA多条件Application.Match出现类型不匹配错误求解

我在VBA中尝试用多条件匹配获取满足条件的患者行号，已经将结果变量place定义为Variant，但仍出现类型不匹配错误，错误提示为(r1 = pacient) = 'type mismatch'。相关代码如下：

Sub AutoFactura()

Dim WS As Worksheet
Dim WF As Worksheet
Dim WP As Worksheet
Dim Rng As Range
Dim Codi As Range
Dim Ara As Range
Dim CopyRange As Range
Dim r1 As Range, r2 As Range
Dim i As Integer
Dim p As Integer
Dim PA As Range
Dim pacient As String, F As String
Dim place As Variant

Set WS = Sheets("Agenda")
'Desfiltrar Agenda
On Error Resume Next
WS.ShowAllData
On Error GoTo 0

'Definir worksheets i trobar últimes files i columnes de cada worksheet
Set WF = Sheets("Factura")
Set WP = Sheets("Pacients")
LRP = WP.Cells(Rows.Count, 1).End(xlUp).Row

'definir ranges per multiple criteria match
Set r1 = WS.Range("C2:C5000")
Set r2 = WS.Range("G2:G5000")
F = "F"


i = 1
p = 2

用于多条件匹配的代码片段：

For p = 2 To LRP
    WP.Activate
    Range("L" & p).Select
    pacient = Range("B" & p)
    Do While Range("O" & p).Value = True
        With Application
            place = .Match(1, (r1 = pacient) * (r2 <> F), 0)
        End With
        If Not IsError(place) Then
        putuns = place + 1
        WS.Activate
        Range("J" & putuns).Select
        ActiveCell.FormulaR1C1 = "=IF(RC[-3]=""F"",0,1)"
        Range("J" & putuns + 1).Select
        ActiveCell.FormulaR1C1 = "=IF(AND(RC[-7] =R" & putuns & "C3, MONTH(RC[-8])=MONTH(R" & putuns & "C2),RC[-3] <> ""F""),1,"""")"
        Range("J" & putuns + 1).Select
        Selection.Copy
        Range("J" & putuns + 1 & ":J5000").Select
        ActiveSheet.Paste
        End If  

问题根源 #

VBA不支持直接对Range对象执行类似Excel工作表函数的数组式条件判断，r1 = pacient这种写法会触发类型不匹配——因为Range对象和字符串无法直接进行这样的运算。

两种可行解决方案 #

方案1：用Evaluate解析数组条件

通过Evaluate将工作表式的数组逻辑转换成可被Match识别的数组，代码修改如下：

With Application
    ' 用Evaluate生成符合条件的数组，再执行Match
    place = .Match(1, .Evaluate("(" & r1.Address(External:=True) & "=""" & pacient & """)*(" & r2.Address(External:=True) & "<>""" & F & """)"), 0)
End With

• 使用Address(External:=True)确保跨工作表引用时不会出错；
• 字符串类型的条件值需要用双引号转义（""表示一个双引号）；
• 生成的数组中，满足双条件的位置为1，其余为0，Match会找到第一个1的相对位置。

方案2：遍历Range逐个判断（适合小数据量）

如果数据范围不大，手动遍历区域判断条件更直观，也能避免类型问题：

place = False ' 初始化标记为非匹配状态
For Each cell In r1
    ' r2对应G列，是C列偏移4列的位置
    If cell.Value = pacient And cell.Offset(0, 4).Value <> F Then
        ' 计算Match返回的相对位置（从r1的第一行开始计数）
        place = cell.Row - r1.Row + 1
        Exit For ' 找到第一个匹配项后退出循环
    End If
Next cell

额外优化建议 #

• 避免使用Activate和Select：直接通过对象引用操作单元格，提升代码效率和稳定性：

  ' 替换原有的选择激活代码
  If Not IsError(place) Then
      putuns = place + 1
      With WS
          .Range("J" & putuns).FormulaR1C1 = "=IF(RC[-3]=""F"",0,1)"
          With .Range("J" & putuns + 1)
              .FormulaR1C1 = "=IF(AND(RC[-7] =R" & putuns & "C3, MONTH(RC[-8])=MONTH(R" & putuns & "C2),RC[-3] <> ""F""),1,"""")"
              .Copy .Range("J" & putuns + 1 & ":J5000")
          End With
      End With
  End If
  

• 确保类型一致：如果WP.Range("B" & p)返回的是数值类型，需要转换为字符串：pacient = CStr(WP.Range("B" & p).Value)。

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