VBA跨工作表动态范围自动筛选：单值场景424错误修复求助

错误原因 #

出现Run-time error 424: Object required的核心问题：

• 当srCount = 1时，你对数组元素Data(1,1)调用了.value属性，但Data是Variant类型的数组，并非Excel单元格对象，数组元素不存在.value属性，直接赋值即可。
• 原代码中重复写了Data = srg.value，这行完全多余，会覆盖之前的赋值操作。

修复后的关键代码段 #

将原错误的单值处理代码：

If srCount = 1 Then ' one cell (row)
    ReDim Data(1 To 1, 1 To 1): Data(1, 1).value = srg.value
    Data = srg.value
End If

替换为：

If srCount = 1 Then ' one cell (row)
    ReDim Data(1 To 1, 1 To 1)
    Data(1, 1) = srg.Value ' 直接给数组元素赋值，去掉多余的.value调用
Else ' multiple cells (rows)
    Data = srg.Value
End If

完整修复代码 #

Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet: Set sws = wb.Worksheets("RecordTabella")
Dim srg As Range
Dim srCount As Long

With sws.Range("C2")
    Dim lCell As Range: Set lCell = .Resize(sws.Rows.Count - .Row + 1) _
        .Find("*", , xlFormulas, , , xlPrevious)
    If lCell Is Nothing Then Exit Sub ' empty criteria column range
    srCount = lCell.Row - .Row + 1
    Set srg = .Resize(srCount)
End With

Dim Data As Variant
If srCount = 1 Then ' one cell (row)
    ReDim Data(1 To 1, 1 To 1)
    Data(1, 1) = srg.Value
Else ' multiple cells (rows)
    Data = srg.Value
End If

Dim arr() As String: ReDim arr(1 To srCount) ' 1D one-based
Dim r As Long
For r = 1 To srCount
    arr(r) = Data(r, 1)
Next r

Dim dws As Worksheet: Set dws = wb.Worksheets("Applicazioni")
If dws.FilterMode Then dws.ShowAllData
Dim drg As Range: Set drg = dws.Range("A8:C1000")
drg.AutoFilter 1, arr, xlFilterValues

额外优化建议 #

可以省略单独处理单值的逻辑，直接用Data = srg.Value——当srg是单个单元格时，Data会自动成为一个1x1的二维数组，无需手动ReDim。简化后这部分代码可写成：

Dim Data As Variant
Data = srg.Value ' 单个单元格时自动生成1x1二维数组，无需分支判断

Dim arr() As String: ReDim arr(1 To srCount) ' 1D one-based
Dim r As Long
For r = 1 To srCount
    arr(r) = Data(r, 1)
Next r

这样能减少分支逻辑，让代码更简洁。

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