首先VBA代码...寻找反馈，使其更快

我写了一个小VBA宏来比较两个工作表，并将唯一值放到一个新的第三工作表。该代码有效，但每次使用时，如果excel出现“无响应”，并在30-45秒后回来，一切正常。首先VBA代码...寻找反馈，使其更快

我可以做得更快，摆脱“没有回应”的问题吗？这只是我的电脑速度不够快吗？

我从每张表中大约2500-2700行开始比较。

Sub FilterNew() 
Dim LastRow, x As Long 

Sheets.Add(After:=Sheets(Sheets.Count)).Name = "New"  'Adds a new Sheet to store unique values 
Sheets(1).Rows("1:1").Copy Sheets("New").Rows("1:1")  'Copies the header row to the new sheet 
Sheets(1).Select 
LastRow = Range("B1").End(xlDown).Row 
Application.ScreenUpdating = False 

For Each Cell In Range("B2:B" & LastRow) 
    x = 2  'This is for looking through rows of sheet2 
    Dim unique As Boolean: unique = True 

    Do 
     If Cell.Value = Sheets(2).Cells(x, "B").Value Then 'Test if cell matches any cell on Sheet2 
      unique = False  'If the cells match, then its not unique 
      Exit Do   'And no need to continue testing 
     End If 
     x = x + 1 

    Loop Until IsEmpty(Sheets(2).Cells(x, "B")) 

    If unique = True Then 
     Cell.EntireRow.Copy Sheets("New").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) 
    End If 

Next 

Application.ScreenUpdating = True 

End Sub

来源

2016-12-01 D. Smith

除了性能问题，您AR e指的是，看到人们记录他们的代码令人耳目一新。做得好！！！ – FDavidov

也许如果您使用临时变量来存储值，并且一次性粘贴新值，而不是'选择行，复制行，在每个循环周期中粘贴行' – Hackerman

如果您的代码按预期工作并且您'正在寻找关于[代码的任何/所有方面，包括]性能的反馈，[codereview.se]是您想要发布的地方。 **确保你在标题**中陈述了代码的用途，并描述了代码的作用。 –

这属于在代码审查，但这里是一个链接

http://www.excelitems.com/2010/12/optimize-vba-code-for-faster-macros.html

与您的代码的主要问题是：

选择/激活表

复制&粘贴。

解决这些事情，你会被直接设置我的朋友:)

来源

2016-12-01 15:00:22

代替do...loop，找出重复的，我会用range.find方法：

set r = SHeets(2).range("b:b").find cell.value 
if r is nothing then unique = true else unique = false

（快速读写的未经测试）

来源

2016-12-01 15:21:58

这个怎么样（它应该帮助）：

Sub FilterNew() 
Dim Cel, Rng As Range 
Application.ScreenUpdating = False 
Application.DisplayAlerts = False 

Sheets.Add(After:=Sheets(Sheets.Count)).Name = "New"  'Adds a new Sheet to store unique values 
Sheets(1).Rows("1:1").Copy Sheets("New").Rows("1:1")  'Copies the header row to the new sheet 

Set Rng = Sheet(1).Range("B2:B" & Sheet(1).Range("B1").End(xlDown).Row) 

For Each Cel In Rng 
    If Cel.Value <> Sheet(2).Cells(Cel.Row, 2).Value Then Cel.EntireRow.Copy Sheets("New").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) ' The only issue I have with this is that this doesn't actually tell you if the value is unique, it just tells you ins not on the same rows of the first and second sheet - Is this alright with you? 
Next 

Application.ScreenUpdating = True 
Application.DisplayAlerts = True 
End Sub

来源

2016-12-01 17:00:53 Jeremy

首先VBA代码...寻找反馈，使其更快

回答

相关问题