こんにちは！ 健史です。
2つのExcelシートから
・VLOOKUPできた行をExcelのフィルタ機能で選択
・選択したデータを追加したシートや別のExcelを起動し貼り付け
ということありませんか。
さらにフィルタをかける条件をいくつか増やすこともあったりします。
プログラムでVLOOKUPしフィルタして別シートに抽出する処理を作成してみました。
尚この記事は、Excel-VBAを起動して貼り付ければ動作することを目指しています。
Excel-VBAの構造、起動方法、実行方法などを理解されていない方は、以下の記事を参照しながら一度やってみてから対応されることをお勧めします。
実行中に発生したエラーの対処法は、上記記事の2.エラーが発生したときの対処法に記載しています。(この段落のリンクから直接遷移します)
プログラムの作成と実行
今回のサンプルプログラムは
です。
プログラムの概要は以下の通りです。
Excelの関数だけで対応する場合は、
・顧客一覧表に[VLOOKUP]関数を使って、ＤＭ返信結果から検索する
・[FILTER]機能で'#N/A'を除外
・フィルタで残った内容をドラッグ＆コピー
・シート３に貼り付け
といった対応でしょうか。
１回限りであれば良いのかもしれませんが、上記手順ではシート１の内容が崩れます。
しかもVLOOKUPするキーやフォルターの条件が複数あったり、やっているうちにキーやフィルタの条件が変更になったりすることもあります。
そんな時にはプログラムで対応した方が柔軟に素早く対応しやすいと思います。
実行までの手順
1.Excelを起動
2.データ入力
Excel2007以降は、Sheet1のみであるためシートを２つ追加し、全部で３つ作成しておきます。
1).シート１に以下のデータを貼り付ける
ドラッグ＆コピー後にExcelに貼り付けるとき、[形式を選択して貼り付ける]-[テキスト]で貼り付けます。(セル[A1]で[右クリック]、[形式を選択して貼り付ける]-[テキスト])
顧客コード 顧客名 住所 A001 北海道さん 札幌市 A002 青森さん 青森市 A003 岩手さん 盛岡市 A004 宮城さん 仙台市 A005 秋田さん 秋田市 A006 山形さん 山形市 A007 福島さん 福島市
2).シート２に以下のデータを貼り付ける
顧客コード 返信日 出欠 A002 2018/12/1 〇 A003 2018/11/25 〇 A005 2018/12/12 〇 A006 2018/11/22 ×
3.Excel-VBAを起動
Altを押した状態でF8キーを押します。
4.[マクロ名(M):]に'test'と入力(''は不要、''内のtestを入力)
5.[作成(C)]をクリック
私はマクロ名を入力したら、そのままEnterを押します。
6.以下のプログラムをドラッグ＆コピー
Dim ix1, ix2 As Long, ix3, ix1_max, ix2_max As Long
'シート３をクリア
Sheets(3).Cells.Clear
'シート３に見出しをセット
Sheets(3).Cells(1, 1) = Sheets(1).Cells(1, 1)
Sheets(3).Cells(1, 2) = Sheets(1).Cells(1, 2)
Sheets(3).Cells(1, 3) = Sheets(1).Cells(1, 3)
Sheets(3).Cells(1, 4) = Sheets(2).Cells(1, 2)
Sheets(3).Cells(1, 5) = Sheets(2).Cells(1, 3)
'シート１とシート２の最終行を求める
ix1_max = Sheets(1).Range("A1").End(xlDown).Row
ix2_max = Sheets(2).Range("A1").End(xlDown).Row
'シート３に出力するためのカウンタに１をセット(１行目に見出しが書かれている)
ix3 = 1
'変数ix1を２からシート１の最終行まで繰り返す
For ix1 = 2 To ix1_max
'変数ix2を２からシート２の最終行まで繰り返す
For ix2 = 2 To ix2_max
'シート１とシート２で同じ商品コードがあったら
If Sheets(1).Cells(ix1, 1) = Sheets(2).Cells(ix2, 1) Then
ix3 = ix3 + 1
Sheets(3).Cells(ix3, 1) = Sheets(1).Cells(ix1, 1)
Sheets(3).Cells(ix3, 2) = Sheets(1).Cells(ix1, 2)
Sheets(3).Cells(ix3, 3) = Sheets(1).Cells(ix1, 3)
Sheets(3).Cells(ix3, 4) = Sheets(2).Cells(ix2, 2)
Sheets(3).Cells(ix3, 5) = Sheets(2).Cells(ix2, 3)
Sheets(3).Cells(ix3, 4).NumberFormatLocal = "yyyy/m/d"
ix2 = ix2_max
End If
Next
Next
6.以下に貼り付け(ペースト)
Sub test()
ここに貼り付ける
End Sub
7.F5キーで実行
8.実行結果の確認
Book1に切り替えて下さい。
Altを押した状態でTabキーを押して、Book1に位置づいたらTabキーを離すことで切り替わります。
シート３には、顧客一覧表にＤＭ返信結を付加した内容が出力されています。
フローチャート
[For～Next]の部分だけですが、以下の記事のフローチャートを参照下さい。
変数名と処理回数(上記記事では5×5=25回)が異なりますが、処理形式「[For～Next]の中に[For～Next]は同じです。
プログラムの詳細説明
上記フロー同様、プログラムの説明も以下の記事を参照下さい。
上記記事にない部分を追記します。
'変数を定義する
Dim ix1, ix2 As Long, ix3, ix1_max, ix2_max As Long
'シート３をクリア
Sheets(3).Cells.Clear
'シート３に見出しをセット
Sheets(3).Cells(1, 1) = Sheets(1).Cells(1, 1)
Sheets(3).Cells(1, 2) = Sheets(1).Cells(1, 2)
Sheets(3).Cells(1, 3) = Sheets(1).Cells(1, 3)
Sheets(3).Cells(1, 4) = Sheets(2).Cells(1, 2)
Sheets(3).Cells(1, 5) = Sheets(2).Cells(1, 3)
'シート１とシート２の最終行を求める
ix1_max = Sheets(1).Range("A1").End(xlDown).Row
シート１の[A]列の最終行を求める
上記データでは、[8]が入ります。
確認したい場合は[MsgBox("ix1_max=" & ix1_max)]と入力して実行してください。
ix2_max = Sheets(2).Range("A1").End(xlDown).Row
シート２の最終行を求める
シート２の[A]列の最終行を求める
上記データでは、[5]が入ります。
'シート３に出力するためのカウンタに１をセット(１行目に見出しが書かれている)
i3 = 1
'変数ix1を２からシート１の最終行ix1_maxまで繰り返す
For ix1 = 2 To ix1_max
'変数ix2を２からシート２の最終行ix2_maxまで繰り返す
For ix2 = 2 To ix2_max
'シート１とシート２で同じ商品コードがあったら
If Sheets(1).Cells(ix1, 1) = Sheets(2).Cells(ix2, 1) Then
i3 = i3 + 1
Sheets(3).Cells(i3, 1) = Sheets(1).Cells(ix1, 1)
Sheets(3).Cells(i3, 2) = Sheets(1).Cells(ix1, 2)
Sheets(3).Cells(i3, 3) = Sheets(1).Cells(ix1, 3)
Sheets(3).Cells(i3, 4) = Sheets(2).Cells(ix2, 2)
Sheets(3).Cells(i3, 5) = Sheets(2).Cells(ix2, 3)
Sheets(3).Cells(i3, 4).Numberformatlocal = "yyyy/m/d"
ix2 = ix2_max
同じ値が見つかったら、以降は探し行くのを止めるため行う
ix2にix2_maxをセットすることで最終行を処理したことと同じになり
「For ix2 = 2 To ix2_max」のループを抜けます
End If
Next
Next
補足です。
・変数について
３つの変数[ix1,ix2,i3]に加え、シート１とシート２の最終行を示す[ix1_max,ix2_max]を定義します。
・ix1_max = Sheets(1).Range("A1").End(xlDown).Row について
今回の処理は「シート１の2番目から最終行までのデータに対して、シート２の2番目から最終行までのデータを検索する」です。
そのためシート１とシート２それぞれ「どこの行まで処理するのか」が必要があり、最終行を求める処理です。
注意点があります。
シート１のセル[A1]には'顧客コード'の値がありますが、これがnull(Deleteキーで内容を削除した状態)であると、ix1_maxには[2]が入ります。
これはセル[A1]にカーソルを位置付けCtrl+↓で位置付いたところの行番号が入ります。
ですから、途中で空白の列があるシートの場合は、全てに値が入っている列[B1]を選択して記述するとか、セル[A1]がnullで[A2]から有効値が入っている場合には[ix1_max = Sheets(1).Range("B1").End(xlDown).Row]と記述する必要があります。
・Sheets(3).Cells(i3, 4).Numberformatlocal = "yyyy/m/d" について
ただ単に値をコピーしただけでは、シート３のセルは標準形式になってしまうため、日付は数字に変換されてしまいます。
日付形式に変換する方法はいくつかありますが、この方法を使っています。
・ix2 = ix2_max について
上記プログラム内でも書きましたが、シート２を2行目から検索して同じ顧客コードが見つかった場合は、以降の検索処理は不要です。
例えばシート２のデータが100,000行ある場合、2件目で顧客コードが見つかった場合、3～100,000行には無いのに検索処理を実行することになります。
100,000行などデータ量が多い場合には、同じ顧客コードが見つかった後も最後まで処理(無駄な処理)をすると遅いです。
・If文 について
If文で条件を追加する場合です。
(A = B) かつ (C = D)の場合は、以下のように記述します。
If A = B And C = D Then
(A = B) または (C = D)の場合は、以下のように記述します。
If A = B Or C = D Then
1行で長くなり見にくくなる場合は、「_」:アンダーバーで繋ぎます。
If A = B And _
C = D Then
等しくない場合の記述は、以下です。私は①の「< > を繋いだもの」、③「Else」を使います。
①If A <> B Then
②If Not A = B Then
③If A = B Then
Else
最後に
Excelの関数「VLOOKUP」について内部でどのように処理しているのかわかりませんが、プログラミングでやってみました。
今回のサンプルは、通常であれば、ダイレクトメールの返信結果に顧客一覧表の情報を付加するのが一般的かとも考えており、このようなことはやらないかも知れません。
ですが、データ検索処理は行います。
検索する内容は「顧客コード」1項目でしたが、2項目や3項目と複数項目でキーになっている場合にも簡単に対応できます。
また、一致した条件から更にFILTER条件を追加する、例えば「[出欠]が"〇"のみを対象にシート３に出力」といったこともできます。
使うシーンに応じて対応して頂ければと思います。
コメント