把表1中符合条件的行复制到表3中

cysczhumh

数据有5万多行，需要把表1中符合条件的行复制到表3中，用单元格法筛选数据，时间太长了。尝试用字典+数组法，但出现类型不匹配问题。

gwjkkkkk

Option Explicit
Sub TEST3()
    Dim ar, i&, j&, r&, t#, strJoin$
   
    Application.ScreenUpdating = False
    t = Timer
   
    ar = Sheets(2).[A1].CurrentRegion.Value
    For i = 2 To UBound(ar)
        strJoin = strJoin & "," & ar(i, 2)
    Next i
    strJoin = strJoin & ","
   
    ar = Sheets(1).[A1].CurrentRegion.Value
    r = 1
    For i = 2 To UBound(ar)
        If InStr(strJoin, "," & ar(i, 6) & ",") Then
             r = r + 1
             For j = 1 To UBound(ar, 2)
                 ar(r, j) = ar(i, j)
             Next j
        End If
    Next i
   
    Cells.Clear
    [A1].Resize(r, UBound(ar, 2)) = ar
   
    Application.ScreenUpdating = True
    MsgBox "执行完毕!_用时:  " & Format(Timer - t, "0.00") & "  秒", 64
End Sub

gwjkkkkk

请参考。。。

yynrzwh

把表1中复合条件的行复制到表3中.zip (21.01 KB, 下载次数: 9)

2024-3-3 18:58 上传

点击文件名下载附件

cysczhumh

结果完全正确，谢谢！正消化吸收中。

cysczhumh

gwjkkkkk 发表于 2024-3-3 18:32
请参考。。。

程序很高深呀，谢谢！

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.3.3
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     arr = Sheets("Sheet2").UsedRange
   
4.     ReDim brr(1 To 10000, 1 To 6)
   
5.     For i = 2 To UBound(arr)
   
6.         d(arr(i, 2)) = ""
   
7.     Next
   
8.     ar = Sheets("Sheet1").UsedRange
   
9.     For i = 2 To UBound(ar)
   
10.         s = ar(i, 6)
    
11.         If d.exists(s) Then
    
12.             m = m + 1
    
13.             For j = 1 To UBound(ar, 2)
    
14.                 brr(m, j) = ar(i, j)
    
15.             Next
    
16.         End If
    
17.     Next
    
18.     With Sheets("results")
    
19.         .UsedRange.Offset(1).Clear
    
20.         .[a2].Resize(m, UBound(brr, 2)) = brr
    
21.         .[a2].Resize(m, UBound(brr, 2)).Borders.LineStyle = 1
    
22.     End With
    
23.     Set d = Nothing
    
24.     MsgBox "OK！"
    
25. End Sub
    

复制代码

cysczhumh

ykcbf1100 发表于 2024-3-3 19:45
附件供参考。。。

谢谢，结果完全正确！

ykcbf1100

cysczhumh 发表于 2024-3-3 20:29
谢谢，结果完全正确！

比较简单的题