[已解决]请教论坛老师，能否提升下列代码的运算速度

yslvictor

从C列一万多个单元格数据中查找，与另个区域（AB：AK）六、七百个单元格是否有相同的数据，如果有就把这个数据填到G列对应的行上，否则填“无”（C列的长度和AB：AK列的长度不定）。
借鉴相关代码修改了一下，运行起来感觉运算时间有点长，哪位老师辛苦一下帮忙再改动下列代码，提升运算速度。谢谢。

Sub 查找填充数据()
    t = Timer
    Range("G6:G65536,D5").Clear
    Dim Ar, Br, i As Long
    Ar = Range("C6" & ":C" & Range("C65536").End(xlUp).Row)
    ReDim Br(1 To UBound(Ar), 0)
    For i = 1 To UBound(Ar)
        If Application.CountIf(Range("AB12" & ":AK" & Range("AB65536").End(xlUp).Row), Ar(i, 1)) > 0 Then
            Br(i, 0) = Ar(i, 1)
        Else
            Br(i, 0) = "无"
        End If
    Next
    Range("G6:G65536").NumberFormatLocal = "@"
    Range("G6").Resize(UBound(Br)) = Br
    Range("D5") = "耗时" & Timer - t & "秒"
End Sub
查找数据.rar (92 KB, 下载次数: 9)

2016-11-26 12:15 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

grf1973

2016-11-28 10:11

考虑到数值比较规范，都是三位整数，可不用字典，用数组代替，速度还能提高 一点

1. Sub 查找填充数据1()
   
2.     t = Timer
   
3.     Range("G6:G65536,D5").Clear
   
4.     Dim Ar, Br, Cr, i As Long
   
5.     Ar = Range("C6" & ":C" & Range("C65536").End(xlUp).Row)
   
6.     ReDim Br(1 To UBound(Ar), 0)
   
7.     Cr = Range("AB12" & ":AK" & Range("AB65536").End(xlUp).Row)
   
8.     Dim xrr(0 To 999)
   
9.     For i = 1 To UBound(Cr)
   
10.         For j = 1 To UBound(Cr, 2)
    
11.             xrr(Cr(i, j)) = Cr(i, j)
    
12.         Next
    
13.     Next
    
14.    
    
15.     For i = 1 To UBound(Ar)
    
16.         Br(i, 0) = xrr(Ar(i, 1))
    
17.         If Br(i, 0) = "" Then Br(i, 0) = "无"
    
18.     Next
    
19.     Range("G6:G65536").NumberFormatLocal = "@"
    
20.     Range("G6").Resize(UBound(Br)) = Br
    
21.     Range("D5") = "耗时" & Timer - t & "秒"
    
22. End Sub

复制代码

跳转到最佳答案楼层

砂海

If Application.CountIf(Range("AB12" & ":AK" & Range("AB65536").End(xlUp).Row), Ar(i, 1)) > 0 Then

1 橙色部分在循环之外计算 , 现在每次循环都要重复计算
2 用算法 替代 函数

grf1973

1. Sub 查找填充数据1()
   
2.     t = Timer
   
3.     Range("G6:G65536,D5").Clear
   
4.     Dim Ar, Br, Cr, i As Long
   
5.     Ar = Range("C6" & ":C" & Range("C65536").End(xlUp).Row)
   
6.     ReDim Br(1 To UBound(Ar), 0)
   
7.     Set d = CreateObject("scripting.dictionary")
   
8.     Cr = Range("AB12" & ":AK" & Range("AB65536").End(xlUp).Row)
   
9.     For i = 1 To UBound(Cr)
   
10.         For j = 1 To UBound(Cr, 2)
    
11.             d(Cr(i, j)) = Cr(i, j)
    
12.         Next
    
13.     Next
    
14.    
    
15.     For i = 1 To UBound(Ar)
    
16.         Br(i, 0) = d(Ar(i, 1))
    
17.         If Br(i, 0) = "" Then Br(i, 0) = "无"
    
18.     Next
    
19.     Range("G6:G65536").NumberFormatLocal = "@"
    
20.     Range("G6").Resize(UBound(Br)) = Br
    
21.     Range("D5") = "耗时" & Timer - t & "秒"
    
22. End Sub

复制代码

grf1973

考虑到数值比较规范，都是三位整数，可不用字典，用数组代替，速度还能提高 一点

1. Sub 查找填充数据1()
   
2.     t = Timer
   
3.     Range("G6:G65536,D5").Clear
   
4.     Dim Ar, Br, Cr, i As Long
   
5.     Ar = Range("C6" & ":C" & Range("C65536").End(xlUp).Row)
   
6.     ReDim Br(1 To UBound(Ar), 0)
   
7.     Cr = Range("AB12" & ":AK" & Range("AB65536").End(xlUp).Row)
   
8.     Dim xrr(0 To 999)
   
9.     For i = 1 To UBound(Cr)
   
10.         For j = 1 To UBound(Cr, 2)
    
11.             xrr(Cr(i, j)) = Cr(i, j)
    
12.         Next
    
13.     Next
    
14.    
    
15.     For i = 1 To UBound(Ar)
    
16.         Br(i, 0) = xrr(Ar(i, 1))
    
17.         If Br(i, 0) = "" Then Br(i, 0) = "无"
    
18.     Next
    
19.     Range("G6:G65536").NumberFormatLocal = "@"
    
20.     Range("G6").Resize(UBound(Br)) = Br
    
21.     Range("D5") = "耗时" & Timer - t & "秒"
    
22. End Sub

复制代码

grf1973

如果只在你的原代码上修改，可小改如下，速度也有明显提升。

1. Sub 查找填充数据()
   
2.     t = Timer
   
3.     Range("G6:G65536,D5").Clear
   
4.     Dim Ar, Br, i As Long, Rng As Range
   
5.     Ar = Range("C6" & ":C" & Range("C65536").End(xlUp).Row)
   
6.     ReDim Br(1 To UBound(Ar), 0)
   
7.     Set Rng = Range("AB12" & ":AK" & Range("AB65536").End(xlUp).Row)
   
8.     For i = 1 To UBound(Ar)
   
9.         If Application.CountIf(Rng, Ar(i, 1)) > 0 Then
   
10.             Br(i, 0) = Ar(i, 1)
    
11.         Else
    
12.             Br(i, 0) = "无"
    
13.         End If
    
14.     Next
    
15.     Range("G6:G65536").NumberFormatLocal = "@"
    
16.     Range("G6").Resize(UBound(Br)) = Br
    
17.     Range("D5") = "耗时" & Timer - t & "秒"
    
18.    
    
19. End Sub

复制代码

yslvictor

谢谢grf1973老师，的确速度快了不少。

laoau138

grf1973 发表于 2016-11-28 10:15
如果只在你的原代码上修改，可小改如下，速度也有明显提升。

VBA不用ismissing如何实现可选参数

http://www.excelpx.com/thread-426157-1-1.html