Question

我有以下针对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）

不起作用，因为它停在第一个隐藏的行/列。

我可能只是将整个表转储到数组中，然后过滤数组。我还没有弄清楚如何从表中拉出活动过滤器来应用它，但我还没有深入研究它。那就是我现在要做的事情，因为我被其他方式困住了。

欢迎提出任何建议。

DM

Answer 1

要避免REDIM或双循环，您可以使用类似Application.WorksheetFunction.Subtotal(3, Range("A2:A500000"))的内容来快速计算可见行数。

请参阅this question

Answer 2

我使用Target定义我的.SpecialCells(xlCellTypeVisible)范围。 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

Answer 3

下面的代码将为所有行创建一个数组，并将每个行存储到另一个数组中，该数组将所有信息存储在工作表中：

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

Answer 4

你可以在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，但是循环两次，一次设置数组的边界，一次填充数组（它将有自己的内部循环来运行行......）： / p>

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

Answer 5

谢谢大家，一系列答案让我:(不是很优雅，但很快）

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

Excel VBA Listrow到数组

5 个答案: