異なるシートのA列をキーにしてマッチングするには?

Question 41.1 Previous Next
お世話になります。マクロは、超初心者(1週間前に興味をもった)です。
詳細は こちら 172番を利用して、シート1のA列とシート2のA列を比較し、値が同じであればシート3へA列の値とその右のセル数個もコピーする。
シート1のA列のみならシート4へ、シート2のA列のみならシート5へコピーする。

簡単にいえば、シート1のA列とシート2のA列をキーにマッチングの処理がしたいのです。172番を利用しないでも、できる方法があれば、よろしくお願いいたします。 では。
Answer   Copyright (C) 2001.5.3 永井善王
マクロを始めてから1週間しか経っていないのに、ご自分のやりたいことが 172番を応用すれば、できるのではないかと思われたのですね。すごいです。 「172番を利用しないでも、できる方法があれば」とも書かれていますが、せっかく自力で見つけられたのですから、それで進めてみましょう。
多機能なExcelをVBAで操るのですから、色々な方法があります。いたずらに上手い下手にこだわることなく、自分の力にあわせて、正確な結果が得られるマクロが組めたならば、それで良いかと思います。向上心を失わなければ、慣れるに従って上手になれるでしょうから。

500連発・第2弾・172番は昆野憲一氏の作品で、「検索条件に合致したセルの値を別のシートに追記する」と題するサンプルマクロです。
検索対象シート
その機能は、左表の商品コードが
検索値
指定セルの検索値(左図)と一致した場合に、一致したレコード(行)を別のシートに追記します。

そのマクロでは、ループ(繰り返し)処理を使用して表の上から順に1行づつ、商品コードをチェックしています。貼り付ける行は、CurrentRegion.Rows.Count でアクティブセル領域を取得して、その1行下にしています。

質問文によるとシート1がマスターで、そのA列がメインキーのようです。明記されていませんが、そのキーにはダブリがない前提で考えます。そして、シート2がトランザクションで、こちらはキーのダブリがある前提で進みます。

無味乾燥な例題では面白くないので、当日入庫した果物のデータを在庫マスターと照合して、登録済みかどうかで別々のシートに記入することにしてみましょう。

 Sheet1 【在庫マスター】            Sheet2 【入庫トラン】
マスター トランザクション
・登録済み果物ならシート3に
・未登録の果物ならシート5に
・入庫がない果物をシート4に

 記入します。
質問文に「A列の値とその右のセル数個もコピーする」とありますが、必然的に
・未登録の果物の場合は、トランの値をコピーし、
・入庫がない果物の場合は、マスターの値をコピーすることになります。 しかし、
・登録済み果物の場合は、マスターとトランのどちらからでもコピー可能ですが、明記されていないので、トランの値をコピーすることにしておきます。
172番のマクロを改造してみましょう。在庫マスタのA2セルを検索値にして 入庫トランのA列を検索し、合致状況により Sheet3 または Sheet5に追記します。そして、在庫マスタのA6セルになるまで1行づつ繰り返し処理します。

Sheet4へ追記するマクロは、回答が長くなるので省略しますが、下記コードのマスタとトランの関係を逆にすれば実現できます。または、Findメソッドを使う方法がありますので、知りたい場合は、 トップページから[Search]をクリックし、テキストボックスに「Find」と入力して [検索]ボタンをクリックして見てください。 

改造カ所の見分け方
・緑色:172番のまま    ・青色:追加した行    ・赤色:部分修正した行
■■ 異なるシートのA列をキーにしてマッチングするには ■■
Const strMasSheet = "Sheet1"                    '在庫マスタのシート名
Const strSrhSheet = "Sheet2"                    '入庫トランのシート名
Const strDataSheet = "Sheet3"                   '結果記入シート名(登録済み果物)
Const strNothingSheet = "Sheet5"                '結果記入シート名(未登録の果物)
Dim intEndRow As Integer                        '使っていない
Dim intSetRow As Integer                        '追記するための行番号
Dim strSrhCode As String                        '検索値
Dim strStock As String                          '入庫数用変数
Dim strCode As String                           '商品コード用変数
Dim strName As String                           '品目名用変数

Sub psDataCheck_conv()
'-----ワークシートをクリアしておく-----
210 Worksheets("Sheet3").Cells.Clear
220 Worksheets("Sheet4").Cells.Clear
230 Worksheets("Sheet5").Cells.Clear
'-----Sheet1【在庫マスター】の2行目から順番に6行目まで繰り返し処理する-----
310 For intRow = 2 To 6                         '2行から始めて6行まで(1upで)
320     strSrhCode = Sheets(strMasSheet).Cells(intRow, 1) '検索値を取得する
330     strSrhName = Sheets(strMasSheet).Cells(intRow, 2) '品目名  〃
340     strSrhStock = Sheets(strMasSheet).Cells(intRow, 3) '在庫数  〃
350     intNothing = 0                          '無しスイッチをゼロにする
'-----Sheet2【入庫トラン】の2行目から順番に5行目まで繰り返し処理する-----
410     For intCnt = 2 To 5                     '2行から始めて5行まで(1upで)
420         If strSrhCode = Worksheets(strSrhSheet).Cells(intCnt, 1) Then
                                  'もし検索値と検索対象シートの商品コードが一致したら
430            strStock = Worksheets(strSrhSheet).Cells(intCnt, 3) '入庫数を取得
440            strCode = Worksheets(strSrhSheet).Cells(intCnt, 1) '商品コード 〃
450            strName = Worksheets(strSrhSheet).Cells(intCnt, 2) '品目名   〃
460            intSetRow = Sheets(strDataSheet).Range("A1").CurrentRegion. _
                   Rows.Count + 1              'Dataシートの空行を取得する
470           Worksheets(strDataSheet).Cells(intSetRow, 3) = strStock '入庫数
480           Worksheets(strDataSheet).Cells(intSetRow, 1) = strCode '商品コード
490           Worksheets(strDataSheet).Cells(intSetRow, 2) = strName '品目名
500           intNothing = 1                 '無しスイッチを1にする
510         End If
520     Next intCnt                            'intCntの繰り返し
'-----【入庫トラン】がなければ【在庫マスター】の内容をSheet5に記入する-----
610     If intNothing = 0 Then                  'もし無しスイッチがゼロなら
620        intSetRow = Sheets(strNothingSheet).Range("A1").CurrentRegion. _
               Rows.Count + 1                  'Dataシートの空行を取得する
630        Worksheets(strNothingSheet).Cells(intSetRow, 1) = strSrhCode '商品
640        Worksheets(strNothingSheet).Cells(intSetRow, 2) = strSrhName '品目名
650        Worksheets(strNothingSheet).Cells(intSetRow, 3) = strSrhStock '在庫数
660     End If
670 Next intRow                                'intRowの繰り返し
End Sub
172番は検索値が 1つだけですが、質問のケースでは在庫マスタの行数分あります。これが最大の違いで、310~350、670行のコードを追加。また、トランがない場合の処理として 350、500、610~660行を追加しました。

上記のマクロコードは、変数名などに接頭辞(str,intなど)を付けたり、ワークシート名を Constステートメントで宣言したり、本格的なプログラミング手法を用いているので、一見すると難しそうにみえるかも知れません。
あなたがプログラマーを目指している訳ではなくて、そうした書き方では理解しにくいようでしたら、日本語で、かつ、直接表記する方法で書き直してみると良いでしょう。 例えば、strSrhCodeは 検索値、 Sheets(strMasSheet)は Sheets("Sheet1")、 intRowは マスタ行、 intCntは トラン行、 intSetRowは 空行 というように。相当わかりやすくなると思います。
サンプルブックのダウンロードは ここをクリック  (YNxv9594_matching.xls 54KB)
※ 一旦、ブックをハードディスクに保存し、後で改めて開いてから実行してください。

 

Excel VBA Macro