マッチング／Index・Match
このVBAコードは、Excelのマクロで、Index-Match関数を使って、複数のシート間でデータを検索して取得するためのものです。
*シート名を指定
Sub IndexMatch()
Dim GetValue
Dim GetValueRow
Dim GetValueAll
Dim intRow
Dim intCol
Dim LastRow1 As Long
LastRow1 = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Dim LastCol1 As Long
LastCol1 = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
For intRow = 2 To LastRow1 '対象の行カウント（2行目から検索文字入りと想定、今回約20単語とした）
For intCol = 1 To LastCol1 '対象の列カウント（何列対象とするかによって変える、今回は10列分を対象）
'空の検索はしない（このIF文はフォーマット次第で入れない方が早いかも）
If Sheets("検索ﾃﾞｰﾀ").Range("A" & intRow & "").Value = "" Then '検索ワードに関して
Else
GetValue = _
WorksheetFunction.Index(Sheets("相手無し-基あり").Range("A" & intRow & ":AD3000"), _
WorksheetFunction.Match(Sheets("検索する単語を入れるシート").Range("A" & intRow), _
Sheets("Sheet6").Range("C5:C3000"), 0), intCol + 1)
GetValueRow = GetValueRow & GetValue & ","
' WorksheetFunction.Index(Sheets("検索範囲のシートA").Range("C" & intRow + 2 & ":BC3000"), _
’WorksheetFunction.Match(Sheets("検索する単語を入れるシート").Range("A" & intRow), _
’Sheets("検索範囲のシートB").Range("C5:C3000"), 0), intCol + 1)
End If
Next intCol
GetValueAll = GetValueAll & GetValueRow & vbLf
intCol = 1
Next intRow
MsgBox GetValueAll
End Sub
解説
- Sub IndexMatch(): VBAプロシージャの開始を示す宣言です。
- Dim GetValue: 変数の宣言です。GetValueは、検索結果を保持する変数です。
- Dim GetValueRow: 変数の宣言です。GetValueRowは、検索結果を一時的に保持する変数です。
- Dim GetValueAll: 変数の宣言です。GetValueAllは、検索結果を全て保持する変数です。
- Dim intRow: 変数の宣言です。intRowは、検索する行数を保持する変数です。
- Dim intCol: 変数の宣言です。intColは、検索する列数を保持する変数です。
- Dim LastRow1 As Long: 変数の宣言です。LastRow1は、検索対象のシートの最終行を保持する変数です。
- LastRow1 = ActiveSheet.Cells(Rows.Count, 1).終了(xlUp)。Row: 検索対象のシートで、最終行を取得します。
- Dim LastCol1 As Long: 変数の宣言です。LastCol1は、検索対象のシートの最終列を保持する変数です。
- LastCol1 = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column: 検索対象のシートで、最終列を取得します。
- intRow = 2 To LastRow1: 検索対象のシートで、2行目から最終行まで検索します。
- intCol = 1 To LastCol1: 検索対象のシートで、1列目から最終列まで検索します。
- If Sheets(“検索データ”)。Range(“A” & intRow & “”).値 = “” Then: 検索対象のシートで、A列が空白の場合はスキップします。
- GetValue = WorksheetFunction.Index(Sheets(“相手無し-基あり”).Range(“A” & intRow & “:AD3000”), _ WorksheetFunction.Match(Sheets(“検索する単語を入れるシート”)。Range(“A” & intRow), _ シート( “シート6”)。Range(“C5:C3000”), 0), intCol + 1): 検索結果を取得します。Index-Match関数を使って、”相手無し-基あり”シートのA列からAD列のデータを検索し、”検索する単語を入れるシート”のA列から、”Sheet6″シートのC5からC3000までの範
インデックス_マッチ２
このVBAコードは、Excelのワークシート上で実行することを想定しています。具体的には、「元表」という名前のワークシートと「転記先」という名前のワークシートがあることが前提となっています。このVBAコードは、以下のような処理を行います。
- 「元表」シートから、社名行番号をキー、社名を値とするディクショナリを作成する。
- 「元表」シートから、列番号をキー、項目名を値とするディクショナリを作成する。
- 「転記先」シートに対して、社名ループを行い、各社名に対応する「元表」シートの行番号を取得する。
- 「転記先」シートに対して、項目ループを行い、各項目に対応する「元表」シートの列番号を取得し、そのセルの値を「転記先」シートの出力行・出力列に出力する。
*シート名を指定
Sub インデックス_マッチ()
'「元表」シート-------------------------------------------------------------
Dim Sh_Moto As Worksheet
Set Sh_Moto = Worksheets("元表") 'データが入っている表
Dim iRRow As Integer '元表シートの読込行
Dim iRCol As Integer '元表シートの読込列
Const MOTO_KEY_CLM As Long = 3 '「元表」シートのキー列（社名列：C列）
Const MOTO_KEY_ROW As Long = 7 '「元表」シートのキー行（項目見出し行:７行目）
'「転記先」シート-----------------------------------------------------------
Dim Sh_Tenki As Worksheet
Set Sh_Tenki = Worksheets("転記先") '転記したい(データを埋めたい表)
Const KENSAKU_CLM As Long = 2 '「転記先」シートＢ列
Const KENSAKU_ROW As Long = 4 '「転記先」シート４行目
Dim iWRow As Integer '転記先シートの出力行
Dim iWCol As Integer '転記先シートの出力列
'Dictionaryオブジェクトの宣言-----------------------------------------------
Dim dicShamei As Object '元表の行の項目名（社名行番号）ディクショナリ
Dim dicKomoku As Object '元表の列の項目名（列番号）ディクショナリ
Set dicShamei = CreateObject("Scripting.Dictionary")
Set dicKomoku = CreateObject("Scripting.Dictionary")
'【ディクショナリ作成】-----------------------------------------------------
'元表シートから社名のディクショナリを作成
For iRRow = 8 To Sh_Moto.Cells(8, MOTO_KEY_CLM).End(xlDown).Row
'社名をキーとして行番号をディクショナリに保管（同じ社名が複数存在した場合、後勝ちで行番号が上書きされます）
dicShamei(Sh_Moto.Cells(iRRow, "C").Value) = iRRow
Next
'元表シートから項目名のディクショナリを作成
For iRCol = 4 To Sh_Moto.Cells(MOTO_KEY_ROW, 4).End(xlToRight).Column
'項目名をキーとして列番号をディクショナリに保管
dicKomoku(Sh_Moto.Cells(7, iRCol).Value) = iRCol
Next
'【転記処理】----------------------------------------------------------------
'転記先シートの社名ループ
For iWRow = 5 To Sh_Tenki.Cells(5, KENSAKU_CLM).End(xlDown).Row
'社名から元表の行番号を取得
If dicShamei.Item(Sh_Tenki.Cells(iWRow, KENSAKU_CLM).Value) = "" Then
'社名から行番号が取得できない場合は何もしない
Else
'元表の行番号を取得
iRRow = dicShamei.Item(Sh_Tenki.Cells(iWRow, KENSAKU_CLM).Value)
'転記先シートの項目ループ
For iWCol = 4 To Sh_Moto.Cells(KENSAKU_ROW, 4).End(xlToRight).Column
'項目名から元表の列番号を取得
If dicKomoku.Item(Sh_Tenki.Cells(KENSAKU_ROW, iWCol).Value) = "" Then
'項目名から列番号が取得できない場合は何もしない
Else
'元表の列番号を取得
iRCol = dicKomoku.Item(Sh_Tenki.Cells(KENSAKU_ROW, iWCol).Value)
'「元表」シートの取得行・取得列のセルの値を、「転記先」シートの出力行・出力列に出力する
Sh_Tenki.Cells(iWRow, iWCol).Value = Sh_Moto.Cells(iRRow, iRCol).Value
End If
Next iWCol
End If
Next iWRow
MsgBox "完了"
End Sub解説
- まず、元となる「元表」と、データを転記する「転記先」の2つのワークシートをそれぞれ変数に格納します。また、それぞれのワークシートにおいて、キーとなる列や行の位置を定数として設定しています。
- 次に、元表の行と列の項目名をディクショナリに格納します。社名をキーとして行番号、項目名をキーとして列番号を格納します。この処理により、後の処理で転記先シートの社名や項目名から元表の行番号や列番号を取得できるようになります。
- 最後に、転記先シートの社名と項目名に対して、元表のデータを取得して転記する処理を実行します。転記先シートの社名ループと項目ループをそれぞれ回しながら、ディクショナリから取得した行番号と列番号に対応するセルの値を、転記先シートの対応するセルにコピーしていきます。また、社名や項目名から行番号や列番号が取得できない場合は、何もしないようにしています。
- 最後に、処理が完了したことを示すメッセージボックスを表示します。
インデックスマッチ ＊同じものは上書き
2つのシート間でデータを転記するエクセルマクロです。転記先のシートである「転記先」シートの社名列と項目見出し行に対応する列名をキーとして、元表のシートである「元表」シートから該当する値を取得し、転記先のシートに出力します。
*シート名を指定
Sub インデックスマッチをディクショナリ()
Const KENSAKU_CLM As Long = 1 '「転記先」シートＢ列（社名列：C列）
Const KENSAKU_ROW As Long = 1 '「転記先」シート４行目（項目見出し行:4行目）
Const MOTO_KEY_CLM As Long = 1 '「元表」シートのキー列（社名列：C列）
Const MOTO_KEY_ROW As Long = 1 '「元表」シートのキー行（項目見出し行:７行目）
Dim Sh_Moto As Worksheet '「元表」シート
Dim Sh_Tenki As Worksheet '「転記先」シート
'Dictionaryオブジェクトの宣言
Dim dicShamei As Object '元表の社名行番号ディクショナリ
Dim dicKomoku As Object '元表の項目名列番号ディクショナリ
Dim iRRow As Long '元表シートの読込行
Dim iRCol As Long '元表シートの読込列
Dim iWRow As Long '転記先シートの出力行
Dim iWCol As Long '転記先シートの出力列
Set Sh_Moto = Worksheets("元表")
Set Sh_Tenki = Worksheets("転記先")
Set dicShamei = CreateObject("Scripting.Dictionary")
Set dicKomoku = CreateObject("Scripting.Dictionary")
'【ディクショナリ作成】
'元表シート（8行目から最終行）から社名のディクショナリを作成
For iRRow = 2 To Sh_Moto.Cells(2, MOTO_KEY_CLM).End(xlDown).Row
'社名をキーとして行番号をディクショナリに保管（同じ社名が複数存在した場合、後勝ちで行番号が上書きされます）
dicShamei(Sh_Moto.Cells(iRRow, "A").Value) = iRRow
Next
'元表シート（2列目から最終列）から項目名のディクショナリを作成
For iRCol = 2 To Sh_Moto.Cells(MOTO_KEY_ROW, 1).End(xlToRight).Column
'項目名をキーとして列番号をディクショナリに保管
dicKomoku(Sh_Moto.Cells(1, iRCol).Value) = iRCol '7行目の列の値
Next
'【転記処理】
'転記先シート（5行目から最終行）の社名ループ
For iWRow = 2 To Sh_Tenki.Cells(2, KENSAKU_CLM).End(xlDown).Row
'社名から元表の行番号を取得
If dicShamei.Item(Sh_Tenki.Cells(iWRow, KENSAKU_CLM).Value) = "" Then
'社名から行番号が取得できない場合は何もしない
Else
'元表の行番号を取得
iRRow = dicShamei.Item(Sh_Tenki.Cells(iWRow, KENSAKU_CLM).Value)
'転記先シートの項目ループ
For iWCol = 1 To Sh_Moto.Cells(KENSAKU_ROW, 1).End(xlToRight).Column
'項目名から元表の列番号を取得
If dicKomoku.Item(Sh_Tenki.Cells(KENSAKU_ROW, iWCol).Value) = "" Then
'項目名から列番号が取得できない場合は何もしない
Else
'元表の列番号を取得
iRCol = dicKomoku.Item(Sh_Tenki.Cells(KENSAKU_ROW, iWCol).Value)
'「元表」シートの取得行・取得列のセルの値を、「転記先」シートの出力行・出力列に出力する
Sh_Tenki.Cells(iWRow, iWCol).Value = Sh_Moto.Cells(iRRow, iRCol).Value
End If
Next iWCol
End If
Next iWRow
MsgBox "完了"
End Sub解説
- このマクロでは、まず、ディクショナリオブジェクトを作成します。ディクショナリは、キーと値のペアを格納するためのオブジェクトであり、このマクロでは、元表シートの社名行番号と項目名列番号をそれぞれ保管するために使用されます。
- 次に、ディクショナリを作成するためのループが2つあります。1つ目のループでは、元表シートの2行目から最終行まで、社名をキーとして行番号をディクショナリに保管します。2つ目のループでは、元表シートの1列目から最終列まで、項目名をキーとして列番号をディクショナリに保管します。
- その後、転記処理を行うためのループが2つあります。1つ目のループでは、転記先シートの2行目から最終行まで、社名から元表の行番号を取得し、2つ目のループでは、転記先シートの項目見出し行から最終列まで、項目名から元表の列番号を取得します。そして、取得した行番号と列番号を使って、元表の値を転記先のシートに出力します。
- 最後に、処理が完了したことを示すメッセージボックスが表示されます。
コメント