关于VBA筛选问题

lin0527

从原始汇总表中，使用字典和数组的方式，给出1个”型号“条件进行筛选出来，主要是筛选出来，方便做各个型号的数据图表的

ykcbf1100

不用字典，数组就可以了。

ykcbf1100

有条件查询，数组法

1. Sub ykcbf()   '//2024.7.4  查询
   
2.     Application.ScreenUpdating = False
   
3.     With Sheets("汇总表")
   
4.         r = .Cells(.Rows.Count, "a").End(xlUp).Row
   
5.         arr = .[a1].Resize(r, 25)
   
6.     End With
   
7.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
8.     With Sheets("Sheet1")
   
9.         st = .[b1].Value
   
10.         .[a5:y1000] = ""
    
11.         For i = 5 To UBound(arr)
    
12.             If st = Empty Or arr(i, 2) = st Then
    
13.                 m = m + 1
    
14.                 For j = 1 To UBound(arr, 2)
    
15.                     brr(m, j) = arr(i, j)
    
16.                 Next
    
17.             End If
    
18.         Next
    
19.         .[a5].Resize(r, 25) = brr
    
20.     End With
    
21.     Set d = Nothing
    
22.     Application.ScreenUpdating = True
    
23.     MsgBox "OK！"
    
24. End Sub
    

复制代码

lin0527

数组我会的，还是想用VBA来处理，原始数据多的，几万行的

lin0527

原始数据太多了，数组运行的话，速度太慢了

Qs18

Sub qs() '2024/7/4
Dim arr, i
arr = Sheet1.Range("a1").CurrentRegion.Value
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
s = Sheet2.[b1]
For i = 5 To UBound(arr)
    If arr(i, 2) <> Empty And s = arr(i, 2) Then
        m = m + 1
        For j = 1 To UBound(arr, 2)
            brr(m, j) = arr(i, j)
        Next
    End If
Next
Sheet2.Range("a5").Resize(m, UBound(arr, 2)) = brr
MsgBox "完成！"
End Sub

Qs18

试试..............

lin0527

Qs18 发表于 2024-7-4 16:42
试试..............

兄弟，麻烦附件上传一下哦

Qs18

试试...........

英子-TS

Qs18 发表于 2024-7-4 16:43
试试...........

下来看看，小白学习中