vbaを早くしたい

Sheet1に現在のの会員情報Sheet2に新規の申し込みの会員情報があります。
Sheet1のB列の氏名とSheet2のG列の氏名を照合して一致するものをSheet1の右側に必要な事項を転記したい。Sheet1に2000件ほどSheet2に1000件ほどのデータがあります。
添付のvbaで一応結果が得られますが3分弱の時間がかかってしまいます。
早く処理できる方法をご教示ください。

Sub 全体重複確認
Dim i As Long, n As Long, j As Long, C As Range, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
j = wS1.Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To wS1.Cells(Rows.Count, 2).End(xlUp).Row
Set C = wS2.Columns(7).Find(what:=wS1.Cells(i, 2), LookIn:=xlValues, lookat:=xlWhole)
If Not C Is Nothing Then
n = C.Row
wS1.Cells(i, 7).Value = wS2.Cells(n, 1).Value
wS1.Cells(i, 8).Value = wS2.Cells(n, 7).Value
wS1.Cells(i, 9).Value = wS2.Cells(n, 12).Value
wS1.Cells(i, 10).Resize(1, 2).Value = wS2.Cells(n, 15).Resize(1, 2).Value
wS1.Cells(i, 12).Value = wS2.Cells(n, 10).Value
End If
Next i
MsgBox "重複確認しました" & vbCrLf & "OKで重複分だけを表示します。"
Worksheets("Sheet1").Select
ActiveSheet.Range("$A$1:$J$" & j).AutoFilter Field:=8, Criteria1:="<>"
End Sub

質問者からの補足コメント

• sheet1の画像です。

  
    補足日時：2022/09/09 11:15

No.5 ベストアンサー 回答者： tatsumaru77 回答日時： 2022/09/09 12:30

No4です。

No4で問題ないと思いますが、
No4でも遅い場合は、その旨補足してください。
多少の対策は残っています。

この回答へのお礼

処理速度が3分弱から1秒以下（一瞬）になりました。
配列の勉強したいと思います。
他に問題があるかもしれませんが、私にとってはこれで十分です。ありがとうございました。

お礼日時：2022/09/09 13:33

No.4 回答者： tatsumaru77 回答日時： 2022/09/09 12:26

とりあえず、速くなるようにしました。

Sheet2は２行目からデータが開始していること。
Sheet2の最大行はG列できまること
Sheet2のG列に空白はないこと
が前提です。

Sub 全体重複確認()
Dim i As Long, n As Long, j As Long, C As Range, wS1 As Worksheet, wS2 As Worksheet
Dim maxrow2 As Long
Dim key As Variant
Dim row2 As Long
Dim dicT As Object
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
j = wS1.Cells(Rows.Count, 2).End(xlUp).Row
maxrow2 = wS2.Cells(Rows.Count, 7).End(xlUp).Row
For row2 = 2 To maxrow2
key = wS2.Cells(row2, 7).Value
dicT(key) = row2
Next
For i = 2 To wS1.Cells(Rows.Count, 2).End(xlUp).Row
key = wS1.Cells(i, 2).Value
If dicT.exists(key) = True Then
n = dicT(key)
wS1.Cells(i, 7).Value = wS2.Cells(n, 1).Value
wS1.Cells(i, 8).Value = wS2.Cells(n, 7).Value
wS1.Cells(i, 9).Value = wS2.Cells(n, 12).Value
wS1.Cells(i, 10).Resize(1, 2).Value = wS2.Cells(n, 15).Resize(1, 2).Value
wS1.Cells(i, 12).Value = wS2.Cells(n, 10).Value
End If
Next i
MsgBox "重複確認しました" & vbCrLf & "OKで重複分だけを表示します。"
Worksheets("Sheet1").Select
ActiveSheet.Range("$A$1:$J$" & j).AutoFilter Field:=8, Criteria1:="<>"
End Sub

No.3 回答者： fujillin 回答日時： 2022/09/09 12:10

こんにちは

VBAで時間がかかるのは、セルへのアクセス（＝読み/書き）です。
これを改善するには、できるだけメモリ上に値を保持して、そちらで処理を行い、まとめて結果を出力する（＝シートに記入する）方法に変えることです。
セルの読み取り/書き込みは個別に行わずに、まとめて（＝セル範囲で）行うことで、速度は向上します。

ただし、シート全部をメモリに取り込むのはあまりにも非効率ですから、どの部分を対象にするかを考慮する必要があるでしょう。
また、（私は確かめていませんが）FINDメソッドは、何度も繰り返すと遅いという情報があります。
https://officedic.com/excel-vba-highspeed-find/

基本的に、上記の点を改善なさることで、それなりの速度向上が見込めると思います。
その上で、（既回答にもありますが）速度向上のためによく利用される
　Application.ScreenUpdating = False
　Application.Calculation = xlCalculationManual
などを設定しておくことで、もう少しだけ速くできるものと思います。

No.2 回答者： t_fumiaki 回答日時： 2022/09/09 11:15

シート2の1件毎にシート1を全件サーチしてチェックしてるからです。

Findで探してるでしょ？

件数が多い基幹業有無ではマッチングマージが鉄則です。
キー項目で両シートを並べ替えて、マッチングマージ。
やり方は検索して下さい。

数百万件もある訳じゃないから、3分くらいならそれで良いと思いますが。

No.1 回答者： lv4u 回答日時： 2022/09/09 11:08

命令は忘れましたが、処理中に画面更新を停止させ、処理が終了したら、画面更新を再開する方法で、いくらか処理が早くなったと思います。