[[20120514141211]]　『マッチング転記』（ぽむ）　ページの最後に飛ぶ

『マッチング転記』（ぽむ）

お世話様です。

シート名『倉庫』のC列に顧客名　D～Lに商品ごとの売り上げが入っています。
シート名『SUMMARY』のB列に顧客名と『倉庫』のC列の顧客名が一致したら
『倉庫』のD～Lのデータを『SUMMARY』のF～Nに順に格納したいです。

ネットでみつけたコードをいじくって『倉庫』のD列のデータを
『SUMMARY』に転記することができましたが
残りのデータの転記がうまくいきません。

 Dim dic As Object
 Dim c As Range

    Set dic = CreateObject("Scripting.Dictionary")

    'マッチング転記

    With Sheets("倉庫")
        For Each c In .Range("C1", .Range("C" & .Rows.Count).End(xlUp))
            dic(c.Value) = c.Offset(, 1).Value
        Next
    End With

    With Sheets("SUMMARY")
        For Each c In .Range("B4", .Range("B" & .Rows.Count).End(xlUp))
            c.Offset(, 4).Value = dic(c.Value)

        Next
    End With

     End Sub

アドバイスをお願いします。

エクセルは2003 OSはXPです

 一例

 Sub Sample()
    Dim dic As Object
    Dim c As Range
    Dim w As Variant

    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")

    With Sheets("倉庫")
        For Each c In .Range("C1", .Range("C" & .Rows.Count).End(xlUp))
            dic(c.Value) = WorksheetFunction.Index(c.Offset(, 1).Resize(, 9).Value, 1, 0)
        Next
    End With

    With Sheets("SUMMARY")
        For Each c In .Range("B4", .Range("B" & .Rows.Count).End(xlUp))
            If dic.exists(c.Value) Then
                c.Offset(, 4).Resize(, 9).Value = dic(c.Value)
            Else
                c.Offset(, 4).Resize(, 9).ClearContents
            End If
        Next
        .Select
    End With

    Set dic = Nothing
    Application.ScreenUpdating = True
    MsgBox "転記完了"

 End Sub

 (ぶらっと)

ぶらっと様

ありがとうございます！
ばっりしです！
メッセージBOXまでつけてくださって感謝です！

助かりました！

（ぽむ）

コメント返信：

[ 一覧(最新更新順) ]

[[20120514141211]] 『マッチング転記』（ぽむ） ページの最後に飛ぶ

[[20120514141211]]　『マッチング転記』（ぽむ）　ページの最後に飛ぶ