A B C D

Question

我正在尝试使用VBA.Filter函数获得基于0的单维数组。

A B C D

CWT1 ATR1 ATR2 ATR3

1 2 3 4 1 1 3 1 3 1 5 7 3 2 2 1 4 5 2 1 6 7 5 4 4 5 2 2 1 3 2 4 1 3 3 7

我想根据多个匹配条件获取Filtered数组。过滤只需1个匹配条件。

Option Explicit

Sub test()

Dim Dict As Object, Dict1 As Object
Dim Sht As Worksheet
Dim Cell As Range
Dim lRow&, lCol&

Dim Arr

Set Dict = CreateObject("Scripting.Dictionary")
Set Sht = Sheet1

With Sht
    lRow = .Cells(Rows.Count, 1).End(xlUp).Row
    lCol = .Cells(1, Columns.Count).End(xlToLeft).Column

    For Each Cell In .Range(.Cells(1, 1), .Cells(1, lCol)).Cells
        Dict.Add Key:=Cell.Value, Item:=Application.Transpose(.Range(Cell.Offset(1), Cell.Offset(lRow - 1)).Formula)
    Next Cell
Stop
    With Dict
        Set Dict1 = CreateObject("Scripting.Dictionary")
        Dict1.Add "abal", VBA.Filter(Dict.Item("CWT1"), "3", True, vbTextCompare)
    End With

End With
Stop
End Sub

e.g。我想使用VBA.Filter函数过滤一列（数组）中的所有1和2，我该怎么做？

当过滤一列时，我也想要对相应列的值进行SUM化。我怎么能用字典做到这一点？

PS：我不想使用Autofilter / Advanced过滤器或任何基于Sheet的操作，因为我已经将sheet / csv数据拉入Dictionary并且想要在Dictionary（或嵌套词典）中进行所有操作，最好是复制高级过滤器行为。

e.g。如果我在多个条件上过滤父词典，则所有子词典（其他键项）应该相加或对它们执行一些计算。我关闭Filter函数的原因是为了摆脱使用数组和循环行为。

我不太了解如何使用类复制它，但肯定可以用Custom class + Dictionary来完成，不是吗？

更新：

我从@Chris Nielsen的想法创建了这个multiFilter函数，除了它不使用字典并且不需要循环多次。它仅通过匹配循环，仍然使用过滤器。结果以字符串形式连接，然后最终拆分并返回。

这仍然没有解决我如何同时过滤其他键的数组并在它们之间进行一些算术运算。

问题：

这可以在一个类中实现，比如说一个在其键（值）中进行所有过滤，算术运算的Dictionary类等吗？

Function MultiFilter(SourceArray As Variant, Matches As Variant, Optional Include As Boolean, Optional CompareMode As VbCompareMethod = vbBinaryCompare) As Variant
    Dim x&, Arr, sJoined$

    For x = LBound(Matches) To UBound(Matches)
        Arr = VBA.Filter(SourceArray, Matches(x), Include, CompareMode)
        sJoined = sJoined & VBA.Join(Arr, ",") & ","
    Next x

    sJoined = Left(sJoined, Len(sJoined) - 1)
    MultiFilter = Split(sJoined, ",")

End Function

Answer 1

由于`VBA.Filter没有做你想做的事，我建议你推出自己的过滤功能。像这样的东西应该这样做

Function MyFilter(dat As Variant, Criteria() As Variant) As Variant
    Dim dic As Object
    Dim i As Long, j As Long
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(dat) To UBound(dat)
        For j = LBound(Criteria) To UBound(Criteria)
            If dat(i) Like Criteria(j) Then
                dic.Add CStr(i), dat(i)
                Exit For
            End If
        Next
    Next
    MyFilter = dic.Items
End Function

Answer 2

Filter通过VBA

基本上你提出两个问题：

＆＃34;我想使用VBA.Filter函数过滤所有1和2的在一列（数组）中，如何我这样做了吗？＆＃34;
＆＃34;当过滤一列时，我还希望 SUM 相应列的值。＆＃34;

有很多甚至更好的方法可以做到这一点，但是你喜欢过滤，我建议以下步骤来演示一种可能的方法：

ad 1）要解决Filter一次只允许一个标准的问题，您可以在数组中读取值，通过辅助函数对其进行编码（请参阅下面的代码）并过滤单个标准（例如＆＃34;＃＆＃34;），如第3节所示。然后，您可以通过Application.Transpose和ApplicationFilter转置列，以允许通过Filter使用，请参阅第4节。

ad 2）当我将行号（暂时）编码到结果数组中时，您可以通过多种方式获取值。

第5a节演示了如何将其他范围过滤器与工作表函数Subtotal一起使用。

或者第5b节）清理数组，以便根据过滤器数组通过 Application.Sum 获得所选列的结果。

注意

对于使用此代码的任何词典，IMO 无需。相反，您可以在任何循环或提到的部分中对值进行求和。

一列的示例代码（例如A列）

此示例在A列中进行过滤和求和，但您可以轻松更改更多列。 注意： Application.Index(v, 0, 1)从2-dim数据字段数组中获取第一个列，Application.Index(v, 0, 4)可以获得第四个列 D 如果您定义更宽的范围，例如Set rng = ws.Range("A2:D" & n)。

Option Explicit Sub DoSomething() ' Declare variables Dim a() Dim ws As Worksheet Dim rng As Range, i As Integer, n As Long, v As Variant ' 1) define your sheetname and range (e.g. criteria 1,2 in column A) Set ws = ThisWorkbook.Worksheets("MySheet") ' << change to your sheet name n = ws.Range("A" & ws.Rows.Count).End(xlUp).Row Set rng = ws.Range("A2:A" & n) ' assume omitting title row ' 2) set range to a variant 2-dim datafield array v = rng ' 3) CODE array items in column A by appending "#" For i = 1 To UBound(v) If bCheck(v(i, 1)) Then v(i, 1) = v(i, 1) & "#" & i + 1 Next i ' 4) transform to 1-dim array and FILTER defined code "#" (= row number) v = Filter(Application.Transpose(Application.Index(v, 0, 1)), "#", True, False) ' 5a) get coded row numbers via split function and unhide valid rows rng.EntireRow.Hidden = True For i = LBound(v) To UBound(v) ws.Range("A" & Split(v(i) & "#", "#")(1)).EntireRow.Hidden = False Next i ' sum up chosen column via Subtotal function (don't need dictionary) Debug.Print "Filtered Sum of column A is " & WorksheetFunction.Subtotal(109, rng) ' ---------------- ' 5b) alternatively ReDim a(LBound(v) To UBound(v)) For i = LBound(a) To UBound(a) a(i) = Val("0" & Split(v(i), "#")(0)) Next i Debug.Print "Filter array sum is " & Application.Sum(a) & vbNewLine & _ "Result array " & Join(a, ",") End Sub

辅助功能

通过上述程序调用该函数;如果还有其他条件需要检查，请修改它。

Function bCheck(ByVal v) As Boolean ' Purpose: Helper function to check conditions v = 1 or v = 2 If v = 1 Then bCheck = True If v = 2 Then bCheck = True End Function

具有多个匹配的VBA过滤器功能

A B C D

CWT1 ATR1 ATR2 ATR3

更新：

问题：

2 个答案: