在Excel VBA中筛选数组

Question

如何过滤多维数组？

我的代码既不起作用也不看起来很整洁：

Option Explicit
Sub CalcE()
Dim TotalRows As Long
Dim myArray, myArray2 As Variant
Dim i, a As Integer

填充数组

TotalRows = Sheets("Data").Rows(Rows.Count).End(xlUp).Row
myArray = Sheets("Data").Range("A5:F" & TotalRows)
MsgBox "Array populated with " & UBound(myArray) & "entries."

将数组条目过滤到myArray 2中，但仅限于第1,4和6列。

a = 0
For i = 0 To UBound(myArray)
    If myArray(i, 1) > 1 Then
        myArray2(a, 1) = myArray(i, 1)
        myArray2(a, 2) = myArray(i, 4)
        myArray2(a, 3) = myArray(i, 6)
        a = a + 1
    End If
Next i    
MsgBox "Array populated now with " & UBound(myArray2) & "entries."
End Sub

我用google搜索并认为Excel中的数组似乎是非常不灵活的东西，不适合使用。人们通常会放弃VBA Arrays并使用AutoFilter方法。我是否真的没有好办法。有这么好吃！

Answer 1

如果您只需要将第1,4和6列存储到myArray2中，请尝试一下......

Dim ws As Worksheet
Set ws = Sheets("Data")
TotalRows = ws.Rows(Rows.Count).End(xlUp).Row
myArray2 = Application.Index(ws.Cells, Evaluate("Row(5:" & TotalRows & ")"), Array(1, 4, 6))

或者你可以像这样调整你的代码......

Dim ws As Worksheet
Set ws = Sheets("Data")
Dim cnt As Long, j As Long
TotalRows = ws.Rows(Rows.Count).End(xlUp).Row
myArray = ws.Range("A5:F" & TotalRows).Value
cnt = Application.CountIf(ws.Range("A5:A" & TotalRows), ">1")
If cnt = 0 Then Exit Sub
ReDim myArray2(1 To cnt, 1 To 3)
For i = 1 To UBound(myArray, 1)
    If myArray(i, 1) > 1 Then
        j = j + 1
        myArray2(j, 1) = myArray(i, 1)
        myArray2(j, 2) = myArray(i, 4)
        myArray2(j, 3) = myArray(i, 6)
    End If
Next i

MsgBox UBound(myArray2, 1)

Answer 2

数组不是很灵活：特别是不容易调整大小（尽管你可以使用Redim Preserve这样做）。

我个人会使用一个Collection，如果你想要一个可变数量的项目，或者想要在VBA中过滤项目。

首先使用表示2D数组列的属性或字段定义类模块。您应该为类及其属性提供有意义的名称和适当的数据类型，但我不知道您的应用程序，因此我将使用：

Class Module "MyClass":

    Public Col1 As Variant
    Public Col4 As Variant
    Public Col6 As Variant

然后，您可以创建一个Collection并将类的实例添加到它，如下所示：

Dim col As Collection
Set col = New Collection
For i = LBound(myArray, 1) To UBound(myArray, 1)
    If myArray(i, 1) > 1 Then
        Dim c As MyClass
        Set c = New MyClass
        c.Col1 = myArray(i, 1)
        c.Col4 = myArray(i, 4)
        c.Col6 = myArray(i, 6)
        col.Add c
    End If
Next I

然后你可以进一步过滤它，例如：

Dim col2 As Collection
Set col2 = New Collection
For Each c In col
    If c.Col1 = 5 Then
        col2.Add c
    End If
Next c

最后将其复制回2D数组，以便将其写回Excel工作表：

Dim myArray2() As Variant
Dim c As MyClass
ReDim myArray2(0 To col2.Count - 1, 0 To 6)
For i = 0 To col2.Count - 1
    Set c = col2(i + 1) ' Collection indexes are 1-based
    myArray2(i, 1) = c.Col1
    myArray2(i, 4) = c.Col4
    myArray2(i, 6) = c.Col6
Next i

您甚至可以编写一个类模块，它是strongly-typed collection的MyClass对象，类模块MyClassCollection，如链接博客文章中所述。