VBA 筛选结果存入数组

:自动筛选--获取可见行（数据）

数据自动筛选，按第3列的缺勤进行筛选后，将筛选结果复制到F：H.

Sub 获取可见数据()
    Dim LastRow As Long
    Dim Rng As Range, Rng1 As Range
    With ActiveSheet
        .UsedRange
        LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row '返回最后一行行号
        Set Rng = .Range("A1:C" & LastRow) '获取数据区域
        Rng.AutoFilter Field:=3, Criteria1:="缺勤"   '筛选B列,状态为缺勤的数据
        Set Rng1 = Rng.SpecialCells(xlCellTypeVisible) '获取可见行数据（筛选的数据)
        Rng.AutoFilter '关闭自动筛选
        Rng1.Copy .Range("F1") '复制可见数据到单元格F1
    End With
End Sub

其中，rng1的数据是否可以一次性装入数组中，如装入arr中。则：代码复制功能可以省略改为数组赋值：

arr=rng1
但实质上这样做，只能得到第一个area数据，因此，应循环多个area：

For Each r In Rng1.Areas

最终才能实现数组赋值：

[f1].resize(ubound(arr),ubound(arr,2))=arr

Sub 获取可见数据2()
    Dim LastRow As Long
    Dim rng As Range, Rng1 As Range
    Dim arr() As Variant
    
    With ActiveSheet
        .UsedRange
        LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row '返回最后一行行号
        Set rng = .Range("A1:C" & LastRow) '获取数据区域
        rng.AutoFilter Field:=3, Criteria1:="缺勤"   '筛选B列,状态为缺勤的数据
        Set Rng1 = rng.SpecialCells(xlCellTypeVisible) '获取可见行数据（筛选的数据)
        lc = Rng1.Columns.Count
        lr = Rng1.Cells.Count / lc
        ReDim arr(1 To lr, 1 To lc)
        For Each r In Rng1.Areas
            a = r
            
            For i = 1 To UBound(a)
                m = m + 1
                For j = 1 To UBound(a, 2)
                    arr(m, j) = a(i, j)
                    Debug.Print arr(m, j)
                Next
            Next
        Next
        
        rng.AutoFilter '关闭自动筛选
        .[f1].Resize(lr, lc) = arr
    End With
End Sub

最后

以上就是和谐蜜蜂为你收集整理的VBA 筛选结果存入数组的全部内容，希望文章能够帮你解决VBA 筛选结果存入数组所遇到的程序开发问题。

如果觉得靠谱客网站的内容还不错，欢迎将靠谱客网站推荐给程序员好友。