请问查找代码如何优化？

wj2368

enrun 发表于 2020-1-30 17:27
是我没有表述清楚，有数据的地方需要用公式链接，不是纯数值。请老师再帮忙看看。

。。。。。。。。。。。。

enrun

wj2368 发表于 2020-2-1 14:42
。。。。。。。。。。。。

谢谢老师，学习了！

YZC51

请参考
工作簿1111.zip (31.54 KB, 下载次数: 1)

2020-2-1 22:59 上传

点击文件名下载附件

answer6141

1. Sub 提取()
   
2. 
   
3. t = Timer
   
4. Dim i, x, y, rng As Range
   
5. x = Sheets("户型").Range("b65536").End(xlUp).Row
   
6. y = Sheets("方案").Range("A65536").End(xlUp).Row + 1
   
7. arr = Sheets("户型").Range("a1:e" & x)
   
8. brr = Sheets("方案").Range("a1:e" & y)
   
9. For i = 3 To UBound(arr)
   
10.     For j = 3 To UBound(brr)
    
11.         With Sheets("方案")
    
12.             If arr(i, 1) <> "" And brr(j, 1) = arr(i, 1) Then
    
13.                 arr(i, 3) = "=方案!" & Replace(.Cells(j, 1).Address, "A", "C")
    
14.                 arr(i, 4) = "=方案!" & Replace(.Cells(j, 1).Address, "A", "D")
    
15.                 arr(i, 5) = "=方案!" & Replace(.Cells(j, 1).Address, "A", "E")
    
16.             End If
    
17.         End With
    
18.     Next
    
19. Next
    
20. Sheets("户型").Range("a1").Resize(UBound(arr), UBound(arr, 2)) = arr
    
21. MsgBox "提取完成！用时" & Timer - t & "秒！"
    
22. 
    
23. End Sub
    
24. 看看吧，有用请赏花，不知道我理解错没

复制代码

YZC51

优化下。多行输入
listbox多行输入.zip (62.84 KB, 下载次数: 8)

2020-2-2 00:04 上传

点击文件名下载附件

enrun

answer6141 发表于 2020-2-1 23:44

谢谢，这个速度也很快，学习了！

enrun

YZC51 发表于 2020-2-2 00:04
优化下。多行输入

谢谢老师，能实现像下拉列表一样的操作，节省很多时间。