基于AutoFilter条件从单列创建动态数组的VBA实现问题

直接上修正后的代码，解决你当前的两个核心问题：捕获筛选后的可见数据、准确获取最后一行：

Sub tester()
    Dim ws As Worksheet
    Dim LastRow As Long
    Dim filteredUniqueNames As Variant
    
    ' 指定目标工作表，避免依赖ActiveWorkbook的不确定性
    Set ws = ThisWorkbook.Sheets("employees")
    
    ' 准确获取A列最后一行（不受筛选状态影响）
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 提取筛选后A列可见行的唯一值
    filteredUniqueNames = UniquesFromVisibleRange(ws.Range("A2:A" & LastRow))
    
    ' 判断数组是否为空
    If IsEmpty(filteredUniqueNames) Then
        Debug.Print "no values found"
    Else
        Debug.Print "got array of unique values: " & Join(filteredUniqueNames, ", ")
    End If
End Sub

Function UniquesFromVisibleRange(rng As Range) As Variant
    Dim d As Object, c As Range, area As Range
    Dim tmp As String
    
    Set d = CreateObject("scripting.dictionary")
    
    On Error Resume Next
    ' 仅保留筛选后的可见单元格
    Set rng = rng.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    ' 若筛选后无可见行，返回空值
    If rng Is Nothing Then
        UniquesFromVisibleRange = Empty
        Exit Function
    End If
    
    ' 遍历所有可见区域（筛选后可能出现多块不连续区域）
    For Each area In rng.Areas
        For Each c In area.Cells
            tmp = Trim(c.Value)
            If Len(tmp) > 0 Then
                If Not d.Exists(tmp) Then
                    d.Add tmp, 1
                End If
            End If
        Next c
    Next area
    
    ' 返回处理后的唯一值数组
    If d.Count = 0 Then
        UniquesFromVisibleRange = Empty
    Else
        UniquesFromVisibleRange = d.Keys
    End If
End Function

关键改动说明 #

• 准确获取最后一行：替换UsedRange.Rows.Count为ws.Cells(ws.Rows.Count, "A").End(xlUp).Row，这个方法从A列底部向上定位第一个非空单元格，不受筛选状态和UsedRange的异常影响。
• 仅处理可见单元格：用SpecialCells(xlCellTypeVisible)筛选出筛选后显示的单元格，同时遍历所有可能的不连续可见区域（Areas），确保没有遗漏数据。
• 错误处理：增加了“筛选后无可见行”的场景处理，避免代码报错中断。
• 变量逻辑统一：修正原代码中vasWksNames和arr变量不匹配的问题，逻辑更清晰。

使用方法 #

手动在C/D/E任意一列完成筛选后，运行tester宏，即可在立即窗口看到提取到的唯一值数组，后续可直接用filteredUniqueNames变量处理数据。

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