スキルアップ・問題解決なら、モーグにおまかせ！

ご教示をお願いしたい事がございます。
約10000件のデータを互いのシートより照合を行い、マスタシートの
データと入力シートのデータが一致した場合、マスタの項目を転記
しています。
しかし、時間が要してしまいますので、ネット等で検索行い、
  
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
  
の処理を追加しましたが、それでも時間を要します。
そこで、配列での処理が可能なのか調査を行ないました。
以下が現在の記述内容となります。
  
Dim he, he2 As Worksheet
Dim i, j As Long
  
Set he = ThisWorkbook.Sheets(2) 　'マスタデータ
Set he2 = ThisWorkbook.Sheets(3) 　'入力データ
  
For j = 2 To he2.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To he.Cells(Rows.Count, 1).End(xlUp).Row
     If he.Cells(i, 1) = "消しゴム" Then
        If he.Cells(i, 2) = he2.Cells(j, 3) Then
            he2.Cells(j, 3) = he.Cells(i, 4) 　'図番
            he2.Cells(j, 9) = he.Cells(i, 6) 　'個数
            Exit For
        End If
     End If
    Next i
Next j
  
二次元配列になると思いますが、マスタシートの列は13、入力シートは、
17列存在します。
しかし、実際に利用する列はそれぞれ、全てを利用する訳ではございません。
いろいと検索を行いましたが、実際に上記の記述に合わせて解読を行った方が
理解ができると思いご質問をさせて頂きました。
（他にも8シート存在しており、それぞれ項目は異なります）
誠に恐縮ではございますが、アドバイスあるいは参考になるようなサイトを
ご存じの場合、ご教示をお願いできないでしょうか。
よろしくお願い致します。

掲示のコードは、実際に動いているコードではありませんね？
コードの添削はしませんが、
実際に動いているコードを掲示しましょう。
  
データ型は、変数ごとに宣言しましょう。
 

引用:

Dim he, he2 As Worksheet
Dim i, j As Long

■作業内容がちょっとよく分からないので、サンプルデータを提示してください。
こんな形式で。

        入力シート(sheets(3))           マスターシート(sheets(2))
    --------------------------          ------------------------------------    
    A(1)  C(3)   I(9)                   A(1)     B(2)       D(4)       F(6) 
1         図番   個数                   品物     ???        図番       個数
2 
3 
4 
5 

Sub　test()
    Dim t
    t = Timer 
    ' ここに作業コードを書きます。
    Debug.Print Timer - t 
End Sub 

WinArrow様
お返事ありがとうございます。
変数のデータ型ですが、修正致しました。
ご指摘ありがとうございました。
今回、ループを利用して、「配列を利用して値の抽出を高速化ができないのか、
可能なら今後に生かせないのか」そのような意味でご質問をさせて頂きました。
 
simple様
お返事ありがとうございます。
以下がサンプルデータとなります。
 
■「???」の部分は「旧図番」となります。
　コードに記述した品物とマスタシートの品物が同じで、
　マスタシートの旧図番 = 入力シートの図番の場合
　　・マスタシート：図番　⇒　入力シート：図番
　　・マスタシート：個数　⇒　入力シート：個数
　に転記します。
 
　　入力シート(sheets(3)　　　　　　　マスターシート(sheets(2)
　　--------------------------　　　　------------------------------------
　　　A(1)　　C(3)　　I(9)　　　　　　　A(1)　　B(2)　　D(4)　　F(6)
　1　 　　　　図番　　個数　　　　　　　品物　　旧図番　図番　　個数
　2
　3
　4
　5
 
■時間ですが、1シートあたり平均、約190秒要します。
 
■"he"の件ですが、シートの内容を変更するので「henko」の最初の頭文字
　2文字から取ったものです。
　不規則な命名で申し訳ございません。
 
お手数をお掛けしますがよろしくお願い致します。

simple様
改めてサンプルデータを記載させて頂きます。
 
　　入力シート(sheets(3)　　　　　　　マスターシート(sheets(2)
　　--------------------------　　　　------------------------------------
　　　A(1)　　C(3)　　I(9)　　　　　　　A(1)　　B(2)　　D(4)　　F(6)
　1　　　　　　A4　　　5　　　　　　　　ゴム　　A3　　　A3　　　10
　2　　　　　　A8　　　5　　　　　　　　ペン　　A4　　　B5　　　20
　3　　　　　　A1　　 10　　　　　　　　ペン　　A5　　　B6　　　10
　4　　　　　　A2　　　5　　　　　　　　ゴム　　A6　　　B7　　　 5
　5　　　　　　A3　　　5　　　　　　　　ゴム　　A7　　　B8　　　10
 
入力シートの変更は、1、5明細が置換対象になります。
大変申し訳ございませんでした。

拝見しました。
見出しだけでなく、サンプルデータが欲しかったのですけどね。
そのほうが回答者も想像がしやすいので。
 
作業の目的は、旧画面コードを新らしい画面コードに変換するということなんですかね。
 
入力シートとマスターシートの掛け算の形で、全ての組み合わせを実行していますが、
速度向上のためには、できるだけ無駄な組合わせは実行しないことです。
一番外側ではすべてを対象にしていますが、
そこに条件を入れて、組み合わせを絞るようなことはできませんか？
 
"消しゴム"というのがいかにも唐突ですが、
されたいことを最初から提示されたほうがよいと思いますよ。
それには、入力シートのA列はなにかとか、必要な要件も提示する必要があるのではないですか？
情報を小出しにされると、却って本質を見失うこともありえます。
 
とりあえずの返答としておきます。

simple様
大変申し訳ございませんでした。
先程、サンプルデータを記載させて頂きました。
 
目的ですが、入力シートの図番とマスタシートの旧図番を照合して一致したら
マスタシートの図番と個数を転記する事です。
 
"消しゴム"というのがいかにも唐突ですが、
されたいことを最初から提示されたほうがよいと思いますよ。
 
　⇒　そのままお聞きするのでは自身の為にならないと思い最小限の
　　　ご質問をさせて頂き、アドバイスを頂いたコードを基に修正を
　　　心掛けたかったのです。
　　　申し訳ございませんでした。
 
入力シートのA列はなにかとか、必要な要件も提示する必要があるのではないですか？
情報を小出しにされると、却って本質を見失うこともありえます。
 
　⇒　入力シートのA列は日付になります。
　　　今後はこの点を気を付けてご質問をさせて頂きます。
 
改めてお詫び申し上げます。
よろしくお願い致します。

動作確認しておりませんが、下記のコードではいかがでしょうか。

Sub test2()
    Dim wsM As Worksheet, wsD As Worksheet
    Dim dic As Object
    Dim s As String
    Dim k As Long, j As Long

    Set wsM = ThisWorkbook.Sheets(2)     'マスタデータ
    Set wsD = ThisWorkbook.Sheets(3)     '入力データ
    Set dic = CreateObject("Scripting.Dictionary")

    With wsM
        For k = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            If .Cells(k, 1) = "消しゴム" Then
                dic(.Cells(k, 2).Value) = k
            End If
        Next
    End With

    With wsD
        For j = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            s = .Cells(j, 3).Value
            If dic.Exists(s) Then
                k = dic(s)
                .Cells(j, 3) = wsM.Cells(k, 4)        '図番
                .Cells(j, 9) = wsM.Cells(k, 6)        '個数
            End If
        Next
    End With
End Sub

引用:

     If he.Cells(i, 1) = "消しゴム" Then

質問のコードを機械的に配列処理に変換したコードです。
内容のロジックについてはなんら吟味してません。
 

Public Sub ArraySample()
    Dim he As Worksheet, he2 As Worksheet
    Set he = ThisWorkbook.Sheets(2)              'マスタデータ
    Set he2 = ThisWorkbook.Sheets(3)             '入力データ
    Dim ary, ary2
    ary = he.Range("A1").CurrentRegion.Value     'マスタデータの表範囲を配列に格納
    ary2 = he2.Range("A1").CurrentRegion.Value   '入力データの表範囲を配列に格納
    
    Dim i, j As Long
    For j = 2 To UBound(ary2)
        For i = 2 To UBound(ary)
            If ary(i, 1) = "消しゴム" Then
                If ary(i, 2) = he2.Cells(j, 3) Then
                    ary2(j, 3) = ary(i, 4) '図番
                    ary2(j, 9) = ary(i, 6) '個数
                    Exit For
                End If
            End If
        Next i
    Next j

    he2.Range("A1").CurrentRegion.Value = ary2 '更新した配列を表範囲に代入
End Sub

simpleさんのコードを拝借して、配列で処理するようにしてみました。
 

Public Sub DictionarySample()
    Dim he As Worksheet, he2 As Worksheet
    Set he = ThisWorkbook.Sheets(2)              'マスタデータ
    Set he2 = ThisWorkbook.Sheets(3)             '入力データ
    Dim ary, ary2
    ary = he.Range("A1").CurrentRegion.Value     'マスタデータの表範囲を配列に格納
    ary2 = he2.Range("A1").CurrentRegion.Value   '入力データの表範囲を配列に格納
    
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim i As Long
    For i = 2 To UBound(ary)
        If ary(i, 1) = "消しゴム" Then
            dic(ary(i, 2)) = i             'Key:旧図番, Item:行番号
        End If
    Next
    
    Dim j As Long, s As String
    For j = 2 To UBound(ary2)
        s = ary2(j, 3)
        If dic.Exists(s) Then '入力シートの図番がDictionaryに存在したら
            i = dic(s)
            ary2(j, 3) = ary(i, 4)               '図番
            ary2(j, 9) = ary(i, 6)               '個数
        End If
    Next j

    he2.Range("A1").CurrentRegion.Value = ary2   '更新した配列を表範囲に代入
End Sub

何度も同じ質問をさせていただきます。
 
サンプルデータが、いままで説明された内容と整合しているのでしょうか？

ひろまさ さんの引用:
simple様
改めてサンプルデータを記載させて頂きます。
 
　　入力シート(sheets(3)　　　　　　　マスターシート(sheets(2)
　　--------------------------　　　　------------------------------------
　　　A(1)　　C(3)　　I(9)　　　　　　　A(1)　　B(2)　　D(4)　　F(6)
　1　　　　　　A4　　　5　　　　　　　　ゴム　　A3　　　A3　　　10
　2　　　　　　A8　　　5　　　　　　　　ペン　　A4　　　B5　　　20
　3　　　　　　A1　　 10　　　　　　　　ペン　　A5　　　B6　　　10
　4　　　　　　A2　　　5　　　　　　　　ゴム　　A6　　　B7　　　 5
　5　　　　　　A3　　　5　　　　　　　　ゴム　　A7　　　B8　　　10
 
入力シートの変更は、1、5明細が置換対象になります。
大変申し訳ございませんでした。

simple様
お返事ありがとうございました。
一瞬で処理が完了しました。
きちんと処理内容を確認させて頂きます。
感謝でいっぱいです。
サンプル項目で"消しゴム"の記載を行い、処理内容を混乱をさせて
しまった事に対してお詫び申し上げます。
ありがとうございました。
 
hatena様
夜遅くにお返事を頂きありがとうございました。
ネットで配列について学習を行いましたが、やはり自身が行いたい
処理で確認を行い、配列について内容の理解ができました。
今後、利用させて頂きます。
ありがとうございました。
 
WinArrow様
何度もお返事を頂きありがとうございました。
サンプルの内容に問題がありご迷惑をお掛けしました。
条件の"消しゴム"については、架空の条件です。
本来はマスタのＡ列に商品名を入力しており、各シートにも該当する
同一の商品名を記載しています。
そこで、マスタの商品名が各シートの名前と同一の場合は、その内容を
転記する仕組を作成していました。
そこで、その処理に時間を要するのでご質問をさせて頂いたのが経緯です。
気に掛けて頂きありがとうございました。