[已解决]代码运行速度慢，有没有更好的方法？

wling1228

希望达到的效果是：将“逾期明细表0925”中的数据复制到后面的“today”sheet,并且保留最大日期对应的“类型”栏的值，其它“类型”中的值都删除。

写了代码如下，但是觉得运行太慢，请问还有没有更高效的方法？谢谢！
Sub copy()
Dim x As Integer
Dim D As Date
'Dim t As String
'D = Year(Now() - 1) & "/" & Month(Now() - 1) & "/" & Day(Now() - 1)

Sheets("逾期明细表0925").Activate
x = Cells(Rows.Count, "a").End(xlUp).Row
ActiveSheet.Range("A2:Y" & x).Select
Selection.copy
Sheets("today").Activate
ActiveSheet.Range("a2").Select
ActiveSheet.Paste
D = Application.WorksheetFunction.Max(Range("l3:l" & x))
ActiveSheet.Range("A2:AD" & x).AutoFilter Field:=12, Criteria1:="<>" & D, Operator:=xlFilterValues
With Range("y3:y" & x)
.SpecialCells(xlCellTypeVisible).Value = ""
.EntireRow.Hidden = False
End With
End Sub

最佳答案

月排行榜 / 总排行榜

grf1973

2014-10-13 10:56

1. Sub copy()
   
2.     Dim x As Integer
   
3.     Dim D As Date
   
4.     Dim Sh As Worksheet
   
5.     Set Sh = Sheets("Today")
   
6.     With Sheets("逾期明细表0925")
   
7.         x = .Cells(.Rows.Count, "a").End(xlUp).Row
   
8.         .Range("A2:Y" & x).copy Sh.Range("a2")
   
9.     End With
   
10.     D = Application.WorksheetFunction.Max(Sh.Range("l3:l" & x))
    
11.     Sh.Range("A2:AD" & x).AutoFilter Field:=12, Criteria1:="<>" & D, Operator:=xlFilterValues
    
12.     With Sh.Range("y3:y" & x)
    
13.         .SpecialCells(xlCellTypeVisible).Value = ""
    
14.         .EntireRow.Hidden = False
    
15.     End With
    
16. End Sub
    

复制代码

跳转到最佳答案楼层

qh8600

像Select这种多了，肯定慢的

wling1228

qh8600 发表于 2014-10-11 18:53
像Select这种多了，肯定慢的

谢谢，那有其它更好的方法吗？是不是可以不用select呢？

qh8600

wling1228 发表于 2014-10-13 09:48
谢谢，那有其它更好的方法吗？是不是可以不用select呢？

像这种的
ActiveSheet.Range("A2:Y" & x).Select
Selection.copy
可以简化为
ActiveSheet.Range("A2:Y" & x).copy

Sheets("逾期明细表0925").Activate这个不需要
直接用
with Sheets("逾期明细表0925")
.Range("A2:Y" & x).copy
........
end with

可以快不少

grf1973

1. Sub copy()
   
2.     Dim x As Integer
   
3.     Dim D As Date
   
4.     Dim Sh As Worksheet
   
5.     Set Sh = Sheets("Today")
   
6.     With Sheets("逾期明细表0925")
   
7.         x = .Cells(.Rows.Count, "a").End(xlUp).Row
   
8.         .Range("A2:Y" & x).copy Sh.Range("a2")
   
9.     End With
   
10.     D = Application.WorksheetFunction.Max(Sh.Range("l3:l" & x))
    
11.     Sh.Range("A2:AD" & x).AutoFilter Field:=12, Criteria1:="<>" & D, Operator:=xlFilterValues
    
12.     With Sh.Range("y3:y" & x)
    
13.         .SpecialCells(xlCellTypeVisible).Value = ""
    
14.         .EntireRow.Hidden = False
    
15.     End With
    
16. End Sub
    

复制代码

上清宫主

就复制那么一盘，又能慢到哪里去？如果真慢，那说明有其它问题存在，而不是你选了几回的问题