【EXCEL VBA（マクロ）】XLookup：シート間のデータをマッチングする

XLOOKUP関数とは

Excel VBAで使用できる関数の1つで、指定された検索キーに一致する値をテーブルから返すために使用されます。 XLookup関数は、Excel 2019から導入された新しい関数であり、従来のVLOOKUP関数に代わるものとして設計されています。

XLookup関数は、指定された検索キーが存在しない場合にデフォルト値を返すことができます。また、検索キーの一致する値を部分一致で検索することができる点も特徴です。

ポイント

左側も検索できる
セルを返す（値ではない）
エラーの場合の表示設定が可能
スピルする（一か所のみ関数を入力していなくても、指定範囲にも値が反映）

構文解説

＝XLOOKUP（検索値,検索範囲,戻り範囲,（見つからなかった場合）,一致モード,検索モード）

見つからなかった場合　→　””　（空白）　など
・一致モード　→　0：完全一致　など
・検索モード　→　1：先頭から検索する場合　／-1：末尾から検索する場合

XLookup(lookup_value, lookup_array, return_array[, if_not_found, match_mode, search_mode])

lookup_value：検索する値（必須）
lookup_array：検索する範囲（必須）
return_array：返す値の範囲（必須）
if_not_found：検索値が見つからなかった場合に返す値（省略可能）
match_mode：検索の比較方法（省略可能）
search_mode：検索方法（省略可能）
XLookup関数は、非常に柔軟であり、Excel VBAでデータを検索する際に非常に有用な機能です。

XLookupでシート間のデータをマッチングする

Sub シート間のマッチング_XLookup()
    
Dim i As Long
On Error Resume Next

For i = 2 To ActiveSheet.Previous.Cells(Rows.Count, 1).End(xlUp).Row
        
ActiveSheet.Cells(i, 7) = Application.WorksheetFunction.XLookup(ActiveSheet.Previous.Cells(i, 2), ActiveSheet.Range("B:B"), _
                ActiveSheet.Range("C:C"), "", 0, 1)
Next
  
On Error GoTo 0

MsgBox "完了"
End Sub

解説

このコードは、2つのシートの列を比較し、1つ目のシートの列Bにある値に対して、2つ目のシートの列CをXLOOKUP関数を使って取得しています。処理の流れとしては、1つ目のシートをActiveSheetとして、ActiveSheet.Previousで2つ目のシートを指定し、その範囲内のデータをXLOOKUP関数で検索し、1つ目のシートの7列目に取得したデータを挿入しています。

上記コードのスピードアップ改善

Sub シート間のマッチング_XLookup２()

Dim i As Long
Dim wsCurrent As Worksheet
Dim wsPrevious As Worksheet
Dim lastRow As Long
Dim idCol As Range
Dim nameCol As Range
Dim ageCol As Range

Set wsCurrent = ThisWorkbook.Worksheets("現在のシート名")
Set wsPrevious = ThisWorkbook.Worksheets("以前のシート名")

lastRow = wsPrevious.Cells(wsPrevious.Rows.Count, 1).End(xlUp).Row

Set idCol = wsPrevious.Range("B2:B" & lastRow)
Set nameCol = wsPrevious.Range("C2:C" & lastRow)
Set ageCol = wsPrevious.Range("D2:D" & lastRow)

On Error Resume Next

For i = 2 To lastRow
wsCurrent.Cells(i, 7) = Application.WorksheetFunction.XLookup(wsPrevious.Cells(i, 2), idCol, nameCol, "", 0, 1)
Next

On Error GoTo 0

MsgBox "完了"
End Sub

解説

現在のシートと以前のシートを、明示的に指定しました。
シート名を文字列として扱うために、Worksheetオブジェクトを使用しました。
使用する列の範囲を明示的に指定しました。
セル範囲を指定する際に、具体的な行番号を使用するのではなく、変数とセルの数値プロパティを組み合わせました。
不要なセル範囲を参照しないように、lastRow変数を使用して、範囲を限定しました。

XLookupでシート間のデータをマッチングして新規シート貼付け

Sub シート間のマッチング_テーブルをつくる_新規シート貼付け()

'xlookup関数はセルを返す
Dim UserId As Long
UserId = ActiveSheet.Previous.Range("G2").Value

If UserId = 0 Then
    MsgBox "検索IDを入力してください"
    Sheet1.Range("G2").Select
    Exit Sub
End If

Dim idRng As Range
On Error GoTo myError
Set idRng = Application.WorksheetFunction.XLookup(UserId, Range("B3").ListObject.ListColumns(1).DataBodyRange, _
                Range("B3").ListObject.ListColumns(1).DataBodyRange, "", 0, 1)
                
idRng.EntireRow.Select
Selection.Copy
Worksheets.Add(After:=ActiveSheet).Name = ActiveSheet.Name & "_" & VBA.Format(Now(), "h時mm分ss秒")
Rows("2:2").Select
ActiveSheet.Paste

Application.CutCopyMode = False

Exit Sub

myError:
MsgBox "IDがみつかりません_完了"

MsgBox "完了"
End Sub

XLookupでシート間のデータマッチング、メッセージボックス表示

Sub シート間マッチング_メッセージボックス()
    
'xlookup関数はセルを返す
Dim UserId As Long
UserId = ActiveSheet.Range("G2").Value

If UserId = 0 Then
    MsgBox "検索IDを入力してください"
    ActiveSheet.Range("G2").Select
    Exit Sub
End If

Dim idRng As Range
On Error GoTo myError
Set idRng = Application.WorksheetFunction.XLookup(UserId, ActiveSheet.Previous.Range("B:B"), _
                ActiveSheet.Range("C:C"), "", 0, 1)
idRng.Select

MsgBox "ID:" & UseId & vbCrLf _
            & "氏名：" & idRng.Value & vbCrLf _
            & "年齢：" & idRng.Offset(0, 1).Value & vbCrLf _
            & "性別：" & idRng.Offset(0, 2).Value
Exit Sub

myError:
MsgBox "IDがみつかりません_完了"
End Sub

解説

Application.WorksheetFunction.XLookup（）…

検索値：UserID
検索範囲：ActiveSheet.Previous.Range(“B:B”)
戻り範囲：ActiveSheet.Range(“C:C”)　＊C列すべて
見つからなかった場合：””　＊空欄
一致モード：0　＊完全一致
検索モード：1　＊先頭から検索

XLookup：行の抽出_シート内

Sub シート内_テーブル作成_xlookup_行の抽出()

'xlookup関数はセルを返す
Dim UserId As Long
UserId = ActiveSheet.Range("G2").Value

If UserId = 0 Then
    MsgBox "検索IDを入力してください"
    ActiveSheet.Range("G2").Select
    Exit Sub
End If

Dim idRng As Range
On Error GoTo myError
Set idRng = Application.WorksheetFunction.XLookup(UserId, ActiveSheet.Previous.Range("B3").ListObject.ListColumns(1).DataBodyRange, _
                ActiveSheet.Range("B3").ListObject.ListColumns(1).DataBodyRange, "", 0, 1)
                
idRng.EntireRow.Select
Selection.Copy
Rows("1:1").Select
ActiveSheet.Paste

Application.CutCopyMode = False
Exit Sub

myError:
MsgBox "IDがみつかりません_完了"

MsgBox "完了"
End Sub

【マクロ・VBA】XLookup：シート間のデータをマッチングする