[已解决]关于数组中filter 函数的应用问题

markang

各位老师好!

我想通过filter 函数将符合多个条件的数据存入单元格,用filter 函数有戏吗?
如下面的代码,难道我知道指定一个"C"吗,如果想表达把符合"包含有"c"或"d"的内容都存入到数组中怎么改呢？
我还想将满足条件的对应A列单元格一起放到数组中去，这可以吗？详见附件range("d1:e5")想要的输出效果 filter 函数的应用.rar (12.37 KB, 下载次数: 7)

2015-6-19 14:34 上传

点击文件名下载附件

Sub tt()
Dim arr, arr1
arr = Application.Transpose(Range("b1:b10"))
arr1 = VBA.Filter(arr, "c", True)
Range("d1").Resize(UBound(arr1) + 1, 1) = Application.Transpose(arr1)
End Sub

最佳答案

月排行榜 / 总排行榜

dsmch

2015-6-19 15:26

fiter函数筛选一维数组，效率并不高，返回的结果为二维数组，直接循环

1. Sub Macro1()
   
2. Dim arr, brr, i&, j%, s&
   
3. arr = [a1:b10]
   
4. ReDim brr(1 To UBound(arr), 1 To 2)
   
5. For i = 1 To UBound(arr)
   
6.     If InStr(arr(i, 2), "c") Or InStr(arr(i, 2), "d") Then
   
7.         s = s + 1
   
8.         For j = 1 To UBound(arr, 2)
   
9.             brr(s, j) = arr(i, j)
   
10.         Next
    
11.     End If
    
12. Next
    
13. If s Then [f1].Resize(s, 2) = brr
    
14. End Sub

复制代码

跳转到最佳答案楼层

dsmch

fiter函数筛选一维数组，效率并不高，返回的结果为二维数组，直接循环

1. Sub Macro1()
   
2. Dim arr, brr, i&, j%, s&
   
3. arr = [a1:b10]
   
4. ReDim brr(1 To UBound(arr), 1 To 2)
   
5. For i = 1 To UBound(arr)
   
6.     If InStr(arr(i, 2), "c") Or InStr(arr(i, 2), "d") Then
   
7.         s = s + 1
   
8.         For j = 1 To UBound(arr, 2)
   
9.             brr(s, j) = arr(i, j)
   
10.         Next
    
11.     End If
    
12. Next
    
13. If s Then [f1].Resize(s, 2) = brr
    
14. End Sub

复制代码

爱疯

Sub tt2()
    Dim A, B
    A = Application.Transpose(Range("b1:b10"))    '数据源
    B = Array("c", "d")    '条件

    For i = 0 To UBound(B)
        A = VBA.Filter(A, B(i), True)
    Next i

    Columns(4) = ""
    Range("d1").Resize(UBound(A) + 1, 1) = Application.Transpose(A)
End Sub


把指定条件放在数组里，循环筛选。

markang

谢谢两位的回答,dsmch的测试通过,但爱疯的代码好像不能达到我要求.

不过看上去爱疯的答案非常的简洁,能再改一下达到和dsmch代码一样的效果吗?

爱疯

filter 函数的应用2.rar (17.16 KB, 下载次数: 13)

2015-6-19 15:48 上传

点击文件名下载附件
如果能加辅助列、添加标题，也可以用高级筛选来做。




Sub test2()
    Range("p:q").ClearContents
    Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
                                            CriteriaRange:=Range("g1:g3"), _
                                            CopyToRange:=Range("i1"), _
                                            Unique:=False
End Sub

dsmch

1. Sub 自动筛选()
   
2. [b1].AutoFilter Field:=2, Criteria1:="=*c*", Operator:=xlOr, Criteria2:="=*d*"
   
3. End Sub

复制代码

markang

爱疯的这个答案看不懂了,不过也要谢谢你