EXCEL - マクロ・シート間の照合・修正

質問

EXCEL - マクロ・シート間の照合・修正
すみません、どなたか教えてください。
「シートＡ」と「シートＢ」とで、商品リストのデータを照合し、価格を書き変えたいです。
「シートＡ」を元に、「シートＡ」データより大量データの商品リストに価格に変更をかけたものが「シートB」になります。
【例】
■シートＡ
商品番号　　価格（円）
　001　　　　30
　003　　　　50
　005　　　　60

■シートＢ
商品番号　　価格（円）
　001　　　　25
　002　　　　55
　003　　　　55
　004　　　　40
　005　　　　60

チェックする点は、シートＡにある商品番号をシートＢの商品番号と照合し、同じ番号があれば、シートＢの価格をシートＡの価格に上書きするようにしたいです。価格が変更してなくても上書きしてもかまいません。

現在商品番号を検索して1つ1つ確認して、価格変更しています。
データが膨大にあるので、自動化・効率化を図りたいです。

どなたかよい方法を教えてください。よろしくお願いします。
できれば、ボタンを押してマクロ実行、というのが理想なのですが…。

回答No.4

imogasi

エクセルには有名なVLOOKUP関数が在る。これと同じものがVBAでも使える。
そういうのを知らないのかな。エクセルの関数でVBAでは使えないものもあるが。
手軽なので勉強のこと。
例データ　Sheet2　A1:B3　価格表の部分
A列　　　B列
1 a
2 b
3 c
ーー
Sheet1
A列　　　B列　（実行結果）
1 a
3 c
2 b
ーー
標準モジュールに
Sub test01()
Dim sh1, sh2
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
d = sh1.Range("A65536").End(xlUp).Row
For i = 1 To d
sh1.Cells(i, "B") = Application.WorksheetFunction. _
VLookup(sh1.Cells(i, "A"), sh2.Range("A1:B100"), 2, False)
Next i
End Sub
こんなに短くて済むよ。
ただし新？価格表の行数で上記を変えること。
新？価格表に商品番号が見つからない場合はエラーになるので、その対処を入れること。
On　Eroor　Goto　文など。
ーー
ほかにも多数の処理ロジックはある。
Find法
総なめ法・ソートして２分法
ソートしてマッチング法
MATC関数利用　
SQL利用法
など

お礼

ありがとうございます。
勉強不足ですみません。
いろいろと方法があるようなので、調べてみます。

回答No.3

tom04

こんにちは！
一例です。

↓のコードを標準モジュールに貼り付けてマクロを実行してみてください。

Sub test()
Dim i, j As Long
Dim ws1, ws2 As Worksheet
Set ws1 = Worksheets("SheetA")
Set ws2 = Worksheets("SheetB")
For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
j = ws2.Cells(Rows.Count, 1).End(xlUp).Row
If WorksheetFunction.CountIf(ws2.Range("A2:B" & j), ws1.Cells(i, 1)) Then
ws1.Cells(i, 2) = WorksheetFunction.VLookup(ws1.Cells(i, 1), ws2.Range("A2:B" & j), 2, False)
End If
Next i
End Sub

こんな感じで良いのですかね？
的外れならごめんなさいね。m(__)m

回答No.2

nattocurry

#1です。
#1の回答で書き忘れましたが、

シートＡとシートＢのシート名は、提示どおり「シートＡ」「シートＢ」（全角文字）、
商品番号が列A、価格が列B、項目名が1行目で、データは2行目以降、
データの間に空行は無い、
各シート内に、同じ商品番号は無い、
という前提です。

回答No.1

nattocurry

Sub test()
Dim c1 As Range, c2 As Range
Dim ShA As Worksheet, ShB As Worksheet
Set ShA = Worksheets("シートＡ")
Set ShB = Worksheets("シートＢ")
Set c1 = ShA.Cells(2, 1)
Do Until c1.Value = ""
Set c2 = ShB.Columns(1).Find(c1.Value, , , xlWhole)
If Not c2 Is Nothing Then c2.Offset(, 1).Value = c1.Offset(, 1).Value
Set c1 = c1.Offset(1)
Loop
End Sub

このマクロを、ボタンに登録してください。

お礼

ありがとうございました。
補足で追加要望を致しましたが、
教えていただいた内容で、なんとかできそうです！！
かなりの時間短縮に感動です！！

補足

ありがとうございます。
無事できました！！
私の文章の書き方が間違っていました。
シートＢを基準にシートＡの価格を修正する内容でした。
シート名の入れ替えで思ったような結果が得られました。ありがとうございます。
追加で、変更箇所が複数個所の場合はもう少し複雑になるのですか?列がＢ列ではなく離れたＥ列になった場合も教えていただけると嬉しいです。