[已解决]代码求优化!

zhouxingyu

哪位老师帮忙把附件中的代码完善下.多谢了!
查找TEST.zip (12.66 KB, 下载次数: 6)

2015-8-23 10:22 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

七彩屋

2015-8-23 11:53

1. 
   
2. Sub 查找TEST()
   
3. Dim s As String, i%, x%
   
4. For x = 1 To Sheets("Sheet2").[a65536].End(xlUp).Row
   
5.   s = Sheets("Sheet2").Cells(x, 1)
   
6.   Sheets("Sheet1").Select
   
7.     For n = 1 To Range("a1").End(xlDown).Row
   
8.       On Error Resume Next
   
9.         Cells.Find(What:=s, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
   
10.             xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Activate
    
11.      i = Sheets("Sheet3").[a65536].End(xlUp).Row + 2
    
12.      If i < 4 Then i = 1
    
13.         ActiveSheet.Range(ActiveCell.Address).CurrentRegion.Cut Sheets("Sheet3").Cells(i, 1)
    
14.     Next n
    
15. Next x
    
16. End Sub

复制代码

跳转到最佳答案楼层

七彩屋

1. 
   
2. Sub 查找TEST()
   
3. Dim s As String, i%, x%
   
4. For x = 1 To Sheets("Sheet2").[a65536].End(xlUp).Row
   
5.   s = Sheets("Sheet2").Cells(x, 1)
   
6.   Sheets("Sheet1").Select
   
7.     For n = 1 To Range("a1").End(xlDown).Row
   
8.       On Error Resume Next
   
9.         Cells.Find(What:=s, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
   
10.             xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Activate
    
11.      i = Sheets("Sheet3").[a65536].End(xlUp).Row + 2
    
12.      If i < 4 Then i = 1
    
13.         ActiveSheet.Range(ActiveCell.Address).CurrentRegion.Cut Sheets("Sheet3").Cells(i, 1)
    
14.     Next n
    
15. Next x
    
16. End Sub

复制代码

zhouxingyu

七彩屋 发表于 2015-8-23 11:53

又得到你的帮助,非常感谢!

七彩屋

第7行代码 For n = 1 To Range("a1").End(xlDown).Row 是你原来的  
正确应该是 For n = 1 To Range("a65536").End(xlup).Row

zhouxingyu

七彩屋 发表于 2015-8-23 12:15
第7行代码 For n = 1 To Range("a1").End(xlDown).Row 是你原来的  
正确应该是 For n = 1 To Range("a655 ...

耐心细致,真心感谢!