Excel VBA Listrow数组
我有以下的excel 2013 VBA snippit
For Each r In rr If Not r.Range.Height = 0 Then FNum = FNum + 1 ReDim Preserve testArr(1 To FNum, 1 To 23) testArr(FNum) = r End If Next r 我的目标是从一个过滤的表中获取所有可见的行到一个数组中。
该表可以是任意数量的行，但总是23列。
我发现，如果它隐藏，高度将为零。 但是对于我的生活，我无法弄清楚如何将整行放入数组中。
r = listrow rr = listrows
是的，我知道循环redim糟透了。
SpecialCells（xlCellTypeVisible）
不工作，因为它停在第一个隐藏的行/列。
我可能只是将整个表转储到数组中，然后过滤数组。 我还没有想出如何从表中拉动有源滤波器来应用它，但我还没有深入了解。 那就是我现在要做的，因为我被其他方式困住了。
任何和所有的build议是受欢迎的。
DM
要避免REDIM或双循环，可以使用Application.WorksheetFunction.Subtotal(3, Range("A2:A500000"))快速计算可见行数。
看到这个问题
我使用.SpecialCells(xlCellTypeVisible)来定义我的Target范围。 Target.Cells.Count / Target.Columns.Count会给你行数。 最后，我遍历Target范围内的单元格，基于Target.Columns.Count增加我的计数器。
Public Sub FilteredArray() Dim Data As Variant, r As Range, Target As Range Dim rowCount As Long, x As Long, y As Long Set Target = WorkSheets("Sheet1").ListObjects("Table1").DataBodyRange.SpecialCells(xlCellTypeVisible) If Not Target Is Nothing Then rowCount = Target.Cells.Count / Target.Columns.Count ReDim Data(1 To rowCount, 1 To Target.Columns.Count) x = 1 For Each r In Target y = y + 1 If y > Target.Columns.Count Then x = x + 1 y = 1 End If Data(x, y) = r.Value Next End If End Sub
下面的代码将为所有行创build一个数组，并将这些数据存储到另一个数组中，这些数组将存储表中的所有信息：
Function RowsToArray() Dim lastRow: lastRow = ActiveWorkbook.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row Dim lastCol: lastCol = ActiveWorkbook.ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column Dim newArr() ReDim newArr(lastRow) For r = 0 To lastRow - 1 Dim rowarr() ReDim rowarr(lastCol) For c = 0 To lastCol - 1 rowarr(c) = Cells(r + 1, c + 1).Value Next c newArr(r) = rowarr Next r End Function
你可以在rr而不是行中循环单元格吗？ 如果是这样，就像@SJR所说的那样，你只能Redim Preserve最后的维度，所以我们将不得不切换你的维度。 然后可以使用r.EntireRow.Hidden来检查我们是否在可见行中，如果是的话就增加数组的边界。
以下假设您的数据在列A中开始：
For Each r In rr If Not r.EntireRow.Hidden Then If r.Column = 1 Then If UBound(testArr, 2) = 0 Then ReDim testArr(1 To 23, 1 To 1) Else ReDim Preserve testArr(1 To 23, 1 To UBound(testArr, 2) + 1) End If End If testArr(r.Column, UBound(testArr, 2)) = r End If Next r
编辑：
或者，你可以继续使用ListRows，但循环两次，一次设置数组的边界，一次填充数组（它将有自己的内部循环，通过行…）：
For Each r In rr If Not r.Range.Height = 0 Then Fnum = Fnum + 1 ReDim testArr(1 To Fnum, 1 To 3) End If Next r Fnum = 0 For Each r In rr If Not r.Range.RowHeight = 0 Then Fnum = Fnum + 1 dumarray = r.Range For i = 1 To 3 testArr(Fnum, i) = dumarray(1, i) Next i End If Next r
谢谢大家，一个答案的组合导致我：（不是很优雅，但很快）
For Each r In rr If Not r.Range.Height = 0 Then TNum = TNum + 1 End If Next r ReDim testArr(TNum, 23) For Each r In rr If Not r.Range.Height = 0 Then FNum = FNum + 1 For i = 1 To 23 testArr(FNum, i) = r.Range.Cells(, i) Next i End If Next r