最初のVBAコード...より速くなるようにフィードバックを探しています

Question

小さなVBAマクロを作成して2枚のワークシートを比較し、独自の値を新しい第3ワークシートに配置しました。 コードは機能しますが、Excelが「応答しない」と表示され、30〜45秒後に復帰し、すべてが正常に動作した場合はいつでも使用します。

この処理を高速化し、「応答しない」問題を取り除くことはできますか？私のコンピュータは十分に速くないのですか？

私は比較している各シートで約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 

Answer 1

これはコードレビューに属しますが、ここではあなたのコードでリンク

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

であるあなたの主な問題点は以下のとおりです。

選択/活性化シート

コピー&貼り付け。

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

（すぐに書かれており、未検証）：

は、それらのものを修正して、youllの重複を見つけるためにまっすぐに私の友人:)

Answer 2

代わりdo...loopのを設定して、私はrange.findメソッドを使用しますこれについては（それが役立つはずです）何

Answer 3

：

脇

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