10000行的数据，筛选符合条件的行，用时20多秒，该怎么优化？

xiangbaoan

于箱长 发表于 2022-9-19 10:38
用一个数组就完成了

好久不见，握个爪……


花浪完了，久着哈……

于箱长

xiangbaoan 发表于 2022-9-19 10:51
好久不见，握个爪……

宝安兄好

jiangxiaoyun

遍历就行了

perfect131

筛选，赋值粘贴即可

smiletwo

刚学SQL，练练手（含表头和序号），用时 0.1757813 秒：

ykcbf1100

编码查询，我的电脑上出结果：约0.03秒

还可以模糊查询

ykcbf1100

1. Sub ykcbf()  '//2025.3.18  模糊查询
   
2.     Application.ScreenUpdating = False
   
3.     Dim tm: tm = Timer
   
4.     With Sheets("数据")
   
5.         r = .Cells(Rows.Count, 1).End(3).Row
   
6.         arr = .[a1].Resize(r, 7)
   
7.     End With
   
8.     On Error Resume Next
   
9.     With Sheets("结果")
   
10.         xm = CStr(.[b1].Value)
    
11.         ReDim brr(1 To 10 ^ 5, 1 To 7)
    
12.         For i = 2 To UBound(arr)
    
13.             If xm <> Empty And CStr(arr(i, 1)) Like "*" & xm & "*" = False Then GoTo 100
    
14.             m = m + 1
    
15.             For j = 1 To UBound(arr, 2)
    
16.                 brr(m, j) = arr(i, j)
    
17.             Next
    
18. 100:
    
19.         Next
    
20.         .UsedRange.Offset(3) = Empty
    
21.         If m > 0 Then .[a4].Resize(m, 7) = brr
    
22.     End With
    
23.     Application.ScreenUpdating = True
    
24.     MsgBox "共用时：" & Format(Timer - tm, "0.000") & "秒！"
    
25. End Sub
    

复制代码

opiona

我也来一个数组筛选, 速度不是很好
但他是通用的, 套个函数就获得结果了

补上忘记的附件: 二维数组筛选_GetFilterArray.rar (318.93 KB, 下载次数: 3)

2025-3-21 08:37 上传

点击文件名下载附件

micch

专门用了preserve和Worksheetfunction来降速吗？

ＥＸＣＥＬ小子

1. Sub FilterDataByCode()
   
2.     Dim wsData As Worksheet, wsResult As Worksheet
   
3.     Dim dataArray As Variant
   
4.     Dim searchCode As String
   
5.     Dim i As Long, j As Long, matchCount As Long
   
6.     Dim lastRow As Long, lastCol As Long
   
7.    
   
8.     ' 设置工作表对象
   
9.     Set wsData = ThisWorkbook.Worksheets("数据")
   
10.     Set wsResult = ThisWorkbook.Worksheets("结果")
    
11.    
    
12.     ' 获取查询编码（转换为字符串防止类型不匹配）
    
13.     searchCode = CStr(wsResult.Range("B1").Value)
    
14.    
    
15.     ' 获取数据表最后一行和列数
    
16.     lastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
    
17.     lastCol = wsData.Cells(1, wsData.Columns.Count).End(xlToLeft).Column
    
18.    
    
19.     ' 将数据读入数组
    
20.     dataArray = wsData.Range("A1").Resize(lastRow, lastCol).Value
    
21.    
    
22.    
    
23.     matchCount = 0
    
24.     For i = 2 To UBound(dataArray, 1) ' 假设第一行为标题
    
25.         If CStr(dataArray(i, 1)) = searchCode Then
    
26.             matchCount = matchCount + 1
    
27.             For j = 1 To UBound(dataArray, 2)
    
28.                 dataArray(matchCount, j) = dataArray(i, j)
    
29.             Next j
    
30.         End If
    
31.     Next i
    
32.    
    
33.     If matchCount = 0 Then
    
34.         MsgBox "未找到编码：" & searchCode, vbInformation
    
35.         Exit Sub
    
36.     End If
    
37.    
    
38.    
    
39.     ' 清除旧数据并输出结果
    
40.     With wsResult
    
41.         ' 清除A10及以下所有数据
    
42.         .Range("A10").Resize(.Rows.Count - 9, lastCol).ClearContents
    
43.         ' 输出结果数组
    
44.         .Range("A10").Resize(matchCount, UBound(dataArray, 2)).Value = dataArray
    
45.     End With
    
46.    
    
47.     MsgBox "已找到 " & matchCount - 1 & " 条匹配记录", vbInformation
    
48. End Sub
    

复制代码