将Excel筛选结果获取到VBA数组中

我有一个VBA子例程，用于过滤第4列中具有文本“SV-PCS7”的logging。如何将这些结果存入数组？

Sub FilterTo1Criteria() Dim xlbook As Excel.Workbook Dim xlsheet As Excel.Worksheet Dim ro As Integer Set xlbook = GetObject("C:\07509\04-LB-06 MX-sv.xlsx") Set xlsheet = xlbook.Sheets("04-LB-06 MX") With xlsheet .AutoFilterMode = False .Range("blockn").AutoFilter Field:=1, Criteria1:="SV-PCS7" End With End Sub 

Answer 1

如果您想避免Jeeped（优秀）解决scheme的复杂循环，则可以使用临时表来首先复制可见行。

 Sub test() Dim src As Range, m As Variant, sh As Worksheet Set src = Sheet1.Range("c3").CurrentRegion.SpecialCells(xlCellTypeVisible) Set sh = Worksheets.Add src.Copy sh.Range("a1") m = sh.Range("a1").CurrentRegion Application.DisplayAlerts = False sh.Delete Application.DisplayAlerts = True Debug.Print UBound(m) End Sub 

Answer 2

应用Range.AutoFilter方法并确定有可见的单元格后，您需要使用xlCellTypeVisible通过Range.SpecialCells方法的Range.Areas属性 。 每个区域将有一个或多个行来处理。

 Sub FilterTo1Criteria() Dim a As Long, r As Long, c As Long, vals As Variant Dim xlSheet As Worksheet 'Set xlbook = GetObject("C:\07509\04-LB-06 MX-sv.xlsx") Set xlSheet = Worksheets("04-LB-06 MX") With xlSheet If .AutoFilterMode Then .AutoFilterMode = False 'With .Range("blockn") With .Cells(1, 1).CurrentRegion .AutoFilter Field:=1, Criteria1:="SV-PCS7" 'step off the header row With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0) 'check if there are visible cells If CBool(Application.Subtotal(103, .Cells)) Then 'dimension the array (backwards) ReDim vals(1 To .Columns.Count, 1 To 1) 'loop through the areas For a = 1 To .SpecialCells(xlCellTypeVisible).Areas.Count With .SpecialCells(xlCellTypeVisible).Areas(a) 'loop through the rows in each area For r = 1 To .Rows.Count 'put the call values in backwards because we cannot redim the 'row' For c = LBound(vals, 1) To UBound(vals, 1) vals(c, UBound(vals, 2)) = .Cells(r, c).Value Next c 'make room for the next ReDim Preserve vals(1 To UBound(vals, 1), 1 To UBound(vals, 2) + 1) Next r End With Next a End If End With End With If .AutoFilterMode Then .AutoFilterMode = False End With 'trim off the last empty 'row' ReDim Preserve vals(1 To UBound(vals, 1), 1 To UBound(vals, 2) - 1) 'reorient the array vals = Application.Transpose(vals) 'show the extents Debug.Print LBound(vals, 1) & ":" & UBound(vals, 1) Debug.Print LBound(vals, 2) & ":" & UBound(vals, 2) 'show the values For r = LBound(vals, 1) To UBound(vals, 1) For c = LBound(vals, 2) To UBound(vals, 2) Debug.Print vals(r, c) Next c Next r End Sub 

Preserve选项可以与ReDim语句一起使用，但只有最后一个范围可以重新调整。 我以错误的方向构build了数组，然后使用TRANSPOSE函数来翻转方向。 注意：可以成功翻转的数组元素的数量是有限制的。

Answer 3

看起来最好的方法是循环遍历每一行，检查行是否隐藏（ cell.EntireRow.Hidden = False ），并将该行的数据添加到数组中（如果没有隐藏）。 类似的例子： 最简单的方法来循环通过与VBA过滤列表？