VBA Dictionary 格納した配列を一括入力する際に、アプリケーション定義またはオブジェクト定義のエラーとなる

Question

前提・実現したいこと

VBA初心者です。初めて当サイトを利用します。
至らない部分もあるかと思いますが、お助けいただければ幸いです。

Vlookupの代替として、Dictionaryを使用したいです。
セル参照回数を減らす為に配列へ格納し、配列から一括入力する際にエラーが出てしまいます。

実行時エラー'1004
アプリケーション定義またはオブジェクト定義のエラー

検索結果の出力先 : Book_bのSheet_cのAQ列
検索値 : Book_bのSheet_cのJ列
検索範囲 : Book_dのSheet_eのC~H列　'検索値はC列です
列番号 : 6
検索方法 : 完全一致

補足

・配列からの一括入力時、途中までは正しく入力されます。
・エラーで止まった検索値は、検索範囲に含まれている値です。

発生している問題・エラーメッセージ

格納した配列からの一括入力時にエラー

c.Range(c.Cells(1, 1), c.Cells(hsaigo, 43)) = buff

実行時エラー'1004
アプリケーション定義またはオブジェクト定義のエラー

該当のソースコード

Dim b , d As String
Dim c , e As Worksheet

Dim hsaisho, isaigo As Long
Dim dir As Dictionary
Dim buff As Variant

Dim name_b, name_c As Long

d = Application.GetOpenFilename(",*.xlsx")
    d = Mid(d, InStrRev(d, "\") + 1)
   
    If b <> "False" Then
    
    Workbooks.Open d
    Set e = Workbooks(d).Worksheets("Sheet1")
    
    Else
    
    MsgBox "キャンセルしました"
    
    End If
    
          
    b = Application.GetOpenFilename(",*.XLSX")
    b = Mid(b, InStrRev(b, "\") + 1)

    If b <> "False" Then

    Workbooks.Open b
    Set c = Workbooks(b).Worksheets("Sheet1")
  
     Else
    
    MsgBox "キャンセルしました"
    
    End If


    Set dir = New Dictionary
    
    isaigo = e.Cells(Rows.Count, 3).End(xlUp).row
    hsaisho = c.Cells(Rows.Count, 43).End(xlUp).row + 1
    hsaigo = c.Cells(Rows.Count, 8).End(xlUp).row
    
    MsgBox isaigo
    MsgBox hsaigo
    
    
    
    For name_c = 4 To isaigo
    
    
    If dir.Exists(e.Cells(name_c, 3).Value) = False Then
            dir.Add Key:=e.Cells(name_c, 3).Value, Item:=e.Cells(name_c, 6).Value
        End If
   Next name_c
   

     
    '▼セル参照回数を減らす為に配列へ格納
    buff = c.Range(c.Cells(1, 1), c.Cells(hsaigo, 43))
     
   
   For name_b = hsaisho To hsaigo
   
    buff(name_b, 43) = dir.Item(CStr(buff(name_b, 10)))
    
    Next name_b
    

 '▼配列からまとめて入力
  
    c.Range(c.Cells(1, 1), c.Cells(hsaigo, 43)) = buff

Answer 1

今回のエラーとは関係ないかも知れませんが、いろいろ気になる部分があるので、修正してみました。
修正部分はコメントで理由を説明してますので、参考にしてください。

簡単にサンプルを作成して動作確認しましたかエラーなく動作しました。

Public Sub test()
    Dim b As String, d As String '型は一つずつ指定する、省略するとVariantになる
    Dim c As Worksheet, e As Worksheet '型は一つずつ指定

    Dim hsaisho As Long, hsaigo As Long, isaigo As Long '型は一つずつ指定
    Dim dic As Dictionary 'Dir関数と被るのでdirをdicに変更
    Dim buff As Variant

    Dim name_b As Long, name_c As Long '型は一つずつ指定

    d = Application.GetOpenFilename(",*.xlsx")
'    d = Mid(d, InStrRev(d, "\") + 1) 不要 Workbooks.Open にはフルパスで指定する、ファイル名だけだとカレントディレクトリ

    If d <> "False" Then  ' b を d に変更

        With Workbooks.Open(d) 'ブックを開いて、Withで対象にする
            Set e = .Worksheets("Sheet1")
        End With
    Else

        MsgBox "キャンセルしました"

        Exit Sub 'キャンセルしたなら処理終了しないと後でエラーになる
    End If

    b = Application.GetOpenFilename(",*.XLSX")
'    b = Mid(b, InStrRev(b, "\") + 1) 不要

    If b <> "False" Then

        With Workbooks.Open(b) 'ブックを開いて、Withで対象にする
            Set c = .Worksheets("Sheet1")
        End With
    Else

        MsgBox "キャンセルしました"
        Exit Sub 'キャンセルしたなら処理終了しないと後でエラーになる
    End If

    Set dic = New Dictionary

    isaigo = e.Cells(Rows.Count, 3).End(xlUp).Row
    hsaisho = c.Cells(Rows.Count, 43).End(xlUp).Row + 1
    hsaigo = c.Cells(Rows.Count, 8).End(xlUp).Row

    MsgBox isaigo
    MsgBox hsaigo

    For name_c = 4 To isaigo

        If dic.Exists(e.Cells(name_c, 3).Value) = False Then
            dic.Add Key:=CStr(e.Cells(name_c, 3).Value), Item:=e.Cells(name_c, 6).Value 'キーをCStrで文字列に
        End If
    Next name_c

    '▼セル参照回数を減らす為に配列へ格納
    buff = c.Range(c.Cells(1, 1), c.Cells(hsaigo, 43)).Value '配列として取得するならValueを付けた方かいい

    For name_b = hsaisho To hsaigo

        buff(name_b, 43) = dic.Item(CStr(buff(name_b, 10)))

    Next name_b

    '▼配列からまとめて入力

    c.Range(c.Cells(1, 1), c.Cells(hsaigo, 43)) = buff
End Sub

Comments

[Cabriolet]

分かり易くアドバイス頂きありがとうございます。
ご活用させて頂きます!!

Answer 2

DictionaryにKeyが無いケースを考慮してみてはどうでしょう。

'▼セル参照回数を減らす為に配列へ格納
buff = c.Range(c.Cells(1, 1), c.Cells(hsaigo, 43))

For name_b = hsaisho To hsaigo
  If dir.Exists(CStr(buff(name_b, 10))) Then
    buff(name_b, 43) = dir.Item(CStr(buff(name_b, 10)))
  End If
Next name_b
'▼配列からまとめて入力
c.Cells(1, 1).Resize(UBound(buff, 1), UBound(buff, 2) - LBound(buff, 2) + 1) = buff

Comments

[Cabriolet]

ご回答頂きありがとうございます。
検索値は検索範囲にある値なのですが、エラーになってしまいます。
配列から一括入力した際に、途中までは正しく入力されるのですが...。

[sazi]

後はbuffの大きさで上書きしてみるとどうでしょう。
（追記しました）
※質問のコードはマークダウンして下さいね。

[Cabriolet]

本件に関しては、当方が使用しているデータに問題がありました。
ご回答頂きありがとうございました。

Answer 3

本件に関しては、当方の使用データに問題がありました。

buff = c.Range(c.Cells(1, 1), c.Cells(hsaigo, 43))
上記のA列からAQ列迄の中に1つだけ "＝" が使用されている値がありました。(例　=aaabbbccc" )

c.Range(c.Cells(1, 1), c.Cells(hsaigo, 43)) = buff
その為、一括入力時にエラーが出ておりました。

皆様、丁寧にご回答頂きありがとうございました。
今後とも宜しくお願い致します。

Comments

[sazi]

後学者の役に立てるかもしれませんので、そのデータについて回避したコードを載せておくと良いです。

[Cabriolet]

sazl様
当サイトの活用法までアドバイス頂きありがとうございます。
今回は、"="が悪さをしていたので、単純に"="のみ手動で削除致しました。
ですので、回避コード等は作成できておりません。

今後は、書式の自動型変換によるエラーを留意したいと思います。