按条件多次筛选存入数组

sxo

1. Sub 宏1()
   
2.     Dim filterRange As Range
   
3.     Dim brr() As String, a As Integer, i%, m%
   
4.     Dim filterdata() As Variant
   
5.     a = ThisWorkbook.Worksheets("sheet5").Range("A1").CurrentRegion.Rows.Count
   
6.     ReDim brr(1 To a)
   
7.     For i = 1 To a
   
8.         brr(i) = Worksheets("sheet5").Range("A" & i).Value
   
9.         Dim wa As Worksheet
   
10.         Set wa = ThisWorkbook.Worksheets("sheet1")
    
11.         Dim arr, rng As Range, RngUnion As Range
    
12.         wa.UsedRange.AutoFilter field:=1, Criteria1:=brr(i)
    
13.         On Error Resume Next '如果存在文本，会有类型匹配出错提示，忽略提示继续执行
    
14.         Set rng = wa.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    
15.         filterdata = rng
    
16.         On Error GoTo 0 '恢复
    
17.         
    
18.         If wa.AutoFilterMode Then
    
19.             wa.AutoFilterMode = False '清除筛选
    
20.         End If
    
21.     Next i
    
22.     Set rng = Worksheets("sheet4").Range("A1").CurrentRegion
    
23.         arr = rng
    
24. End Sub
    

复制代码

第一次循环后，数组filterdata内容正确，第二次循环后数组只显示一行。想要实现按学校名称筛选，每次筛选的结果要追加到上一次筛选的结果后面。

tanglf188

参与一下

LIUZHU

这个就是将数组按照A列的排序吧，只是A列的排序方式是给定的

LIUZHU

数组排序这种问题交给WPS吧

LIUZHU

JSA代码简单，效率高

1. function 排序(){
   
2.         const arr=Range("a1").CurrentRegion.Value2;
   
3.         let obj=Sheets.Item("Sheet5").Range("a1").CurrentRegion.Value2.reduce((obj,[x],i)=>(obj[x]=i,obj),{});                //保存排序规则
   
4.         arr.sort(([a],[b])=>arr[0][0]==b || obj[a]-obj[b]);
   
5.         Range("k1").Resize(arr.length,2).Value2=arr;
   
6. }

复制代码

LIUZHU

WPS打开测试，运行JS宏

蓝桥玄霜

筛选的例子：

sxo

蓝桥玄霜 发表于 2024-5-22 18:27
筛选的例子：

代码有问题？最后一个IF语句没有ＥＮＤＩＦ　结束语句。还有最后的
for each 中的if 语句的是什么意思？为什redim arr1(1 to 2,1 to rowcount)是两行四列？元数据是两列？

sxo

sxo

继续顶起，望大家解惑。