代码优化

grf1973

完全根据代码优化的，无法验证。试试吧。

grf1973

1. Sub test()
   
2.     Set dr = CreateObject("scripting.dictionary")  '行
   
3.     Set dc = CreateObject("scripting.dictionary")   '列
   
4.    
   
5.     arr = [a1:y20000]    '考虑到有column+1，原[a1:x20000]向右拓展一列
   
6.     For i = 1 To UBound(arr)  'arr的每个值和其他 行，列相对应
   
7.         For j = 1 To UBound(arr, 2)
   
8.             If Not dr.exists(arr(i, j)) Then
   
9.                 dr(arr(i, j)) = i
   
10.                 dc(arr(i, j)) = j
    
11.             End If
    
12.         Next
    
13.     Next
    
14.    
    
15.     brr = Range("z1:z900")
    
16.     crr = Range("aa1:ac900")
    
17.     For i = 1 To UBound(brr)
    
18.         If Len(brr(i, 1)) Then
    
19.             r = dr(brr(i, 1)): c = dc(brr(i, 1))   '还原值对应的行，列（相当于Find）
    
20.             If r - 7 >= 1 Then
    
21.                 crr(i, 1) = arr(r - 1, c + 1)
    
22.                 crr(i, 3) = arr(r - 7, c)
    
23.             End If
    
24.         End If
    
25.     Next
    
26.    
    
27.     [aa1].Resize(UBound(crr), 3) = crr
    
28. End Sub
    

复制代码

破例

grf1973 发表于 2022-11-17 11:01

非常感谢~~~~~~~~~~~~~~~~~~~~