Excel VBA选取表格列DataBodyRange时遇类型不匹配错误

问题重现 #

尝试通过VBA获取Excel表格列的DataBodyRange时触发错误13（类型不匹配），相关代码如下：

Sheet4.ListObjects("InspectionsPassees").ListColumns("Nom").DataBodyRange

确认表名和列名无误，改用Range属性也会报错，但执行MsgBox(Sheet4.ListObjects("InspectionsPassees").ListColumns("Nom").Range.Count)能正常返回数值66。

完整出错代码片段：

Dim ip As ListObject
Dim nom As Range, prenom As Range, nomJF As Range, DOB As Range, inspP As Range
Set ip = Sheet4.ListObjects("InspectionsPassees")
Set nom = ip.ListColumns("Nom").DataBodyRange
Set prenom = ip.ListColumns("Prenom").DataBodyRange
Set nomJF = ip.ListColumns("Nom_JF").DataBodyRange
Set DOB = ip.ListColumns("Date_naissance").DataBodyRange
Set inspP = ip.ListColumns("À revoir").DataBodyRange
With Sheet3.ListObjects("Contractuels")
    For Each Cx In .ListRows
        If Application.Intersect(Cx.Range, .ListColumns("Cx").Range) = "C0" Then
            Application.Intersect(Cx.Range, .ListColumns("Insp").Range) = "VC"
        ElseIf Application.XLookup(1, nom = Application.Intersect(Cx.Range, .ListColumns("Nom").Range), inspP) = "oui" Then
            Application.Intersect(Cx.Range, .ListColumns("Insp").Range) = "INSP"
        Else: Application.Intersect(Cx.Range, .ListColumns("Insp").Range) = "non"
        End If
    Next Cx
End With

原因分析 #

1. DataBodyRange为Nothing：当表格InspectionsPassees只有表头、没有数据行时，DataBodyRange会返回Nothing，而Range类型变量无法接收Nothing，直接赋值就会触发类型不匹配错误。
2. XLookup参数写法错误：VBA中不能直接用nom = 某单元格值这种数组比较方式作为XLookup的匹配条件，这种写法在单元格公式中可行，但在VBA中会触发类型不匹配。

解决办法 #

1. 先判断DataBodyRange是否存在 #

在赋值列的DataBodyRange前，先检查表格是否有数据行：

Set ip = Sheet4.ListObjects("InspectionsPassees")
' 先检查整个表格的DataBodyRange是否存在
If Not ip.DataBodyRange Is Nothing Then
    Set nom = ip.ListColumns("Nom").DataBodyRange
    Set prenom = ip.ListColumns("Prenom").DataBodyRange
    Set nomJF = ip.ListColumns("Nom_JF").DataBodyRange
    Set DOB = ip.ListColumns("Date_naissance").DataBodyRange
    Set inspP = ip.ListColumns("À revoir").DataBodyRange
Else
    MsgBox "表格InspectionsPassees没有数据行，请先添加数据"
    Exit Sub
End If

2. 修正XLookup的调用方式 #

VBA中调用XLookup时，直接传递单元格区域的Value属性作为参数，同时避免直接写数组比较逻辑：

With Sheet3.ListObjects("Contractuels")
    ' 提前获取目标列的DataBodyRange，避免反复调用Intersect
    Dim colCx As Range, colInsp As Range, colNomCx As Range
    Set colCx = .ListColumns("Cx").DataBodyRange
    Set colInsp = .ListColumns("Insp").DataBodyRange
    Set colNomCx = .ListColumns("Nom").DataBodyRange
    
    Dim i As Long
    Dim lookupValue As String
    Dim xResult As Variant
    
    For i = 1 To .ListRows.Count
        If colCx.Cells(i).Value = "C0" Then
            colInsp.Cells(i).Value = "VC"
        Else
            lookupValue = colNomCx.Cells(i).Value
            ' 直接传递区域的Value属性作为XLookup的参数
            xResult = Application.XLookup(lookupValue, nom.Value, inspP.Value, "")
            If xResult = "oui" Then
                colInsp.Cells(i).Value = "INSP"
            Else
                colInsp.Cells(i).Value = "non"
            End If
        End If
    Next i
End With

3. 多条件匹配的处理（针对原需求） #

如果需要通过姓氏、名字、maiden name及出生日期多列匹配，用Evaluate执行完整的XLookup数组公式，无需担心字符长度限制：

' 假设已获取各列的DataBodyRange：nom、prenom、nomJF、DOB、inspP
With Sheet3.ListObjects("Contractuels")
    Dim colCx As Range, colInsp As Range, colNomCx As Range, colPrenomCx As Range
    Dim colNomJFCx As Range, colDOBCx As Range
    Set colCx = .ListColumns("Cx").DataBodyRange
    Set colInsp = .ListColumns("Insp").DataBodyRange
    Set colNomCx = .ListColumns("Nom").DataBodyRange
    Set colPrenomCx = .ListColumns("Prenom").DataBodyRange
    Set colNomJFCx = .ListColumns("Nom_JF").DataBodyRange
    Set colDOBCx = .ListColumns("Date_naissance").DataBodyRange
    
    Dim i As Long
    Dim evalFormula As String
    Dim xResult As Variant
    
    For i = 1 To .ListRows.Count
        If colCx.Cells(i).Value = "C0" Then
            colInsp.Cells(i).Value = "VC"
        Else
            ' 构建多条件XLookup公式
            evalFormula = "XLOOKUP(1, ('" & ip.Parent.Name & "'!" & nom.Address & "='" & colNomCx.Cells(i).Value & "')*" & _
                          "('" & ip.Parent.Name & "'!" & prenom.Address & "='" & colPrenomCx.Cells(i).Value & "')*" & _
                          "('" & ip.Parent.Name & "'!" & nomJF.Address & "='" & colNomJFCx.Cells(i).Value & "')*" & _
                          "('" & ip.Parent.Name & "'!" & DOB.Address & "=#" & Format(colDOBCx.Cells(i).Value, "yyyy-mm-dd") & "#'), " & _
                          "'" & ip.Parent.Name & "'!" & inspP.Address & ", """")"
            ' 执行公式
            xResult = Application.Evaluate(evalFormula)
            If xResult = "oui" Then
                colInsp.Cells(i).Value = "INSP"
            Else
                colInsp.Cells(i).Value = "non"
            End If
        End If
    Next i
End With

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