- 締切済み
EXCEL - マクロ・シート間の照合・修正
EXCEL - マクロ・シート間の照合・修正 すみません、どなたか教えてください。 「シートA」と「シートB」とで、商品リストのデータを照合し、価格を書き変えたいです。 「シートA」を元に、「シートA」データより大量データの商品リストに価格に変更をかけたものが「シートB」になります。 【例】 ■シートA 商品番号 価格(円) 001 30 003 50 005 60 ■シートB 商品番号 価格(円) 001 25 002 55 003 55 004 40 005 60 チェックする点は、シートAにある商品番号をシートBの商品番号と照合し、同じ番号があれば、シートBの価格をシートAの価格に上書きするようにしたいです。価格が変更してなくても上書きしてもかまいません。 現在商品番号を検索して1つ1つ確認して、価格変更しています。 データが膨大にあるので、自動化・効率化を図りたいです。 どなたかよい方法を教えてください。よろしくお願いします。 できれば、ボタンを押してマクロ実行、というのが理想なのですが…。
- みんなの回答 (4)
- 専門家の回答
みんなの回答
- imogasi
- ベストアンサー率27% (4737/17069)
エクセルには有名な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法 総なめ法・ソートして2分法 ソートしてマッチング法 MATC関数利用 SQL利用法 など
- tom04
- ベストアンサー率49% (2537/5117)
こんにちは! 一例です。 ↓のコードを標準モジュールに貼り付けてマクロを実行してみてください。 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
- nattocurry
- ベストアンサー率31% (587/1853)
#1です。 #1の回答で書き忘れましたが、 シートAとシートBのシート名は、提示どおり「シートA」「シートB」(全角文字)、 商品番号が列A、価格が列B、項目名が1行目で、データは2行目以降、 データの間に空行は無い、 各シート内に、同じ商品番号は無い、 という前提です。
- nattocurry
- ベストアンサー率31% (587/1853)
Sub test() Dim c1 As Range, c2 As Range Dim ShA As Worksheet, ShB As Worksheet Set ShA = Worksheets("シートA") Set ShB = Worksheets("シートB") 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 このマクロを、ボタンに登録してください。
お礼
ありがとうございました。 補足で追加要望を致しましたが、 教えていただいた内容で、なんとかできそうです!! かなりの時間短縮に感動です!!
補足
ありがとうございます。 無事できました!! 私の文章の書き方が間違っていました。 シートBを基準にシートAの価格を修正する内容でした。 シート名の入れ替えで思ったような結果が得られました。ありがとうございます。 追加で、変更箇所が複数個所の場合はもう少し複雑になるのですか?列がB列ではなく離れたE列になった場合も教えていただけると嬉しいです。
お礼
ありがとうございます。 勉強不足ですみません。 いろいろと方法があるようなので、調べてみます。