EXCEL VBA　オリジナル関数CustomXLOOKUP関数でデータ検索をカスタマイズ・オリジナル関数の作り方と活用法（テクニック）

2024年2月5日

EXCEL VBA　オリジナル関数CustomXLOOKUP関数でデータ検索をカスタマイズ・オリジナル関数の作り方と活用法（テクニック）

●はじめに

今回は、EXCEL VBAを使って、データ検索の可能性を広げる「CustomXLOOKUP関数」の紹介とその活用法を解説します。このカスタマイズされた関数は、EXCELの標準機能であるXLOOKUP関数の機能を基にしながら、柔軟な検索オプションを提供します。事例として、特定の条件に基づく検索や、見つからない場合のデフォルト値の設定など、実務で直面する様々なシナリオに対応します。このブログでは、CustomXLOOKUP関数の基本的な使い方から、さらに高度な検索テクニックまで、具体的なコード例とともに紹介します。ビジネスデータの分析やレポート作成を行う際に、このカスタマイズ関数がいかに役立つかを見ていきましょう。また、今回のCustomXLOOKUP関数は、EXCEL2016・Excel2019で利用する事ができます。

【このCustomXLOOKUP関数を事務所業務で有効利用する場面】】
事務所業務におけるデータ管理やレポート作成では、多様な条件に基づいた情報検索が日常的に求められます。例えば、顧客データベースから特定の条件を満たす顧客情報を抽出したり、販売データから特定期間の売上を集計する際に、CustomXLOOKUP関数は大きな効率化をもたらします。この関数を使うことで、検索値が見つからない場合のデフォルト値の設定や、近似値による検索など、標準の検索関数では対応しづらい要件に柔軟に応えることが可能です。また、複雑な条件に基づく情報の検索や集計を、単一の関数呼び出しで実行できるため、作業の手間を大幅に削減し、業務の効率化を実現します。

●【EXCEL VBA あいまいな条件検索・複数条件を検索・該当する文字のみ検索・配列を利用（テクニック）、下記を参照して下さい】

EXCEL VBA あいまいな条件検索・複数条件を検索・該当する文字のみ検索・配列を利用（テクニック）

●【XLookup関数について (Excel)、下記を参照して下さい】（Microsoft社　様）】

https://support.microsoft.com/ja-jp/office/xlookup-%E9%96%A2%E6%95%B0-b7fd680e-6d10-43e6-84f9-88eae8bf5929

EXCEL VBAで業務効率化！カスタムXLOOKUP関数の作り方と活用（オリジナル関数）Excel2016・Excel2019でも動作可能！

●プログラム説明　(サンプル①)

このCustomXLOOKUP関数は、特定の値を検索範囲内で検索し、対応する別の範囲から値を返すものです。標準のXLOOKUP関数と似ていますが、カスタマイズされています。関数は、検索値、検索範囲、返す値の範囲、オプションでデフォルト値を引数として受け取ります。指定された検索値が見つかった場合は、対応する返す値の範囲から値を返します。見つからない場合は、デフォルト値が指定されていればそれを返し、指定されていなければエラー（#N/A）を返します。

【CustomXLOOKUP関数の使い方】

　=CustomXLOOKUP(①検索する値, ②検索配列, ③戻り値配列)

①LookupValue: 検索する値 ‘ ②LookupArray: 検索を行う配列 ‘③ReturnArray: 検索値に対応する値が含まれる配列

・例えば、セルA2に検索する値があり、B2:B10が検索配列、C2:C10が戻り値配列である場合の使用例は以下のようになります。

　=CustomXLOOKUP(A2, B2:B10, C2:C10)

・この関数は、A2の値をB2:B10で検索し、該当する値が見つかった場合にC2:C10の同じ行の値を返します。見つからない場合は、エラー値#N/Aを返します。

【プログラムの流れ】

１．検索範囲の各セルをループ処理でチェックします。
２・検索値が検索範囲内のセルの値と一致するか確認します。
３．一致した場合、対応する返す値の範囲から値を取得し、関数の結果として設定します。その後、ループを抜けます。
４．一致するものがなかった場合、デフォルト値が指定されているか確認します。
５．デフォルト値が指定されていればそれを返し、指定されていなければ#N/Aエラーを返します。

【プログラム実行条件・注意事項】

１．検索範囲と返す値の範囲は同じサイズである必要があります。
２．大規模なデータセットでの使用は、ループ処理によりパフォーマンスが低下する可能性があります。
３．エラー処理が基本的です。より詳細なエラーハンドリングが必要な場合は、コードを拡張する必要があります。
４．オプションのデフォルト値は省略可能ですが、指定しない場合は検索値が見つからないと#N/Aエラーが返されます

★【サンプルプログラム】
下記のリンク先よりサンプルプログラムをダウンロードする事ができます。
●　（サンプルプログラム）CustomXLOOKUP01

'
' 変数宣言する
Option Explicit

' CustomXLOOKUP関数を定義
' LookupValue: 検索する値
' LookupArray: 検索を行う配列
' ReturnArray: 検索値に対応する値が含まれる配列

Function CustomXLOOKUP(LookupValue As Variant, LookupArray As Range, ReturnArray As Range) As Variant
    ' カウンタ変数を定義
    Dim i As Long
    
    ' LookupArray内の各セルをループ処理
    For i = 1 To LookupArray.Cells.Count
        ' もし現在のセルの値が検索値に一致する場合
        If LookupArray.Cells(i).Value = LookupValue Then
            ' 対応するReturnArrayの値を返す
            CustomXLOOKUP = ReturnArray.Cells(i).Value
            ' 関数の実行を終了
            Exit Function
        End If
    Next i
    
    ' 一致する値が見つからない場合は、#N/Aエラーを返す
    CustomXLOOKUP = CVErr(xlErrNA)
End Function
'
'

' 変数宣言する

Option Explicit

' CustomXLOOKUP関数を定義

' LookupValue: 検索する値

' LookupArray: 検索を行う配列

' ReturnArray: 検索値に対応する値が含まれる配列

Function CustomXLOOKUP(LookupValue As Variant, LookupArray As Range, ReturnArray As Range) As Variant

' カウンタ変数を定義

Dim i As Long

' LookupArray内の各セルをループ処理

For i = 1 To LookupArray.Cells.Count

' もし現在のセルの値が検索値に一致する場合

If LookupArray.Cells(i).Value = LookupValue Then

' 対応するReturnArrayの値を返す

CustomXLOOKUP = ReturnArray.Cells(i).Value

' 関数の実行を終了

Exit Function

End If

Next i

' 一致する値が見つからない場合は、#N/Aエラーを返す

CustomXLOOKUP = CVErr(xlErrNA)

End Function

EXCEL VBA　XLOOKUP関数と同じような高度な検索が可能！CustomXLOOKUP関数で検索力を強化する方法！（オリジナル関数）

●プログラム説明　(サンプル②)

このコードは、指定された検索値を検索配列内で検索し、該当する値が見つかった場合に戻り配列から関連する値を返します。検索は完全一致または近似一致で行うことができ、検索方向は前方または後方（ただし、コードでは前方のみ実装されている）、戻り値が見つからない場合のデフォルト値を設定することも可能です。

【CustomXLOOKUP関数の使い方】
=CustomXLOOKUP(①検索する値, ②検索配列, ③戻り値配列, ④デフォルト値, ⑤検索方向, ⑥マッチモード)

【CustomXLOOKUP関数のパラメータ設定】
①検索する値 (lookupValue): 検索したい値。この値を検索配列内で探し、見つかった場合は戻り値配列から対応する値を返します。
②検索配列 (lookupArray): 検索する値を探す範囲を指定するExcelの範囲（Range）。この範囲内で検索値を検索します。
③戻り値配列 (returnArray): 検索値に対応する値を含む範囲を指定するExcelの範囲（Range）。検索値が見つかった場合、この範囲から対応する値が返されます。
④デフォルト値 (defaultValue): オプション。検索値が見つからなかった場合に返す値。指定しない場合、関数はエラー値を返します。
⑤検索方向 (searchDirection): オプション。検索を行う方向を指定します。”forward”（前方検索）がデフォルトです。後方検索はこの実装には含まれていません。
⑥マッチモード (matchMode): オプション。検索モードを指定します。”exact”（完全一致検索）がデフォルトで、”approximate”（近似一致検索）も選択可能です。近似一致検索は数値に対してのみ有効です。

【プログラムの流れ】
1.初期設定で、マッチしたかどうかを示す変数と、近似マッチ用の最短距離とその値を初期化します。
2.検索配列をループして各セルの値を取得し、指定された検索値と比較します。
・完全一致の場合：戻り配列から該当する値を返して関数を終了します。
・近似一致の場合：検索値とセル値の差の絶対値を計算し、これまでに見つかった最短距離よりも小さい場合、その値と距離を更新します。
3.ループ終了後、マッチが見つかった場合は最も近いマッチの値を、見つからなかった場合はデフォルト値またはエラー値を返します。

【プログラム実行条件・注意事項】

・検索配列と戻り配列は同じサイズである必要があります。
・近似一致検索は数値データのみで機能します。
・検索方向は現在の実装では前方のみサポートしています。後方検索はサポートされていません。
・デフォルト値はオプションですが、指定しない場合、マッチが見つからなかった際にエラー値を返します。
・大きなデータセットでの使用は、性能に影響を与える可能性があります。

★【サンプルプログラム】
下記のリンク先よりサンプルプログラムをダウンロードする事ができます。
●　（サンプルプログラム）CustomXLOOKUP02

'
'
Option Explicit

' CustomXLOOKUP関数
Function CustomXLOOKUP(lookupValue As Variant, lookupArray As Range, returnArray As Range, _
                       Optional defaultValue As Variant, _
                       Optional searchDirection As String = "forward", _
                       Optional matchMode As String = "exact") As Variant
    Dim i As Long, j As Long
    Dim matchFound As Boolean
    Dim closestMatch As Variant
    Dim closestDistance As Double
    matchFound = False
    closestDistance = 1E+308   ' 最短距離の初期値を非常に大きな数に設定

    ' lookupArrayの各セルをループして検索値を探す
    For i = 1 To lookupArray.Rows.Count
        For j = 1 To lookupArray.Columns.Count
            Dim cellValue As Variant
            cellValue = lookupArray.Cells(i, j).Value

            ' 完全一致検索の場合
            If matchMode = "exact" And cellValue = lookupValue Then
                ' 戻り値配列から対応する値を取得して関数を終了
                CustomXLOOKUP = GetValueFromReturnArray(returnArray, i, j)
                matchFound = True
                Exit Function
            ' 近似一致検索の場合（数値のみ）
            ElseIf matchMode = "approximate" And IsNumeric(cellValue) And IsNumeric(lookupValue) Then
                ' 検索値との距離を計算
                Dim distance As Double
                distance = Abs(cellValue - lookupValue)
                ' 最短距離よりも小さい場合、最短距離と最も近い値を更新
                If distance < closestDistance Then
                    closestMatch = GetValueFromReturnArray(returnArray, i, j)
                    closestDistance = distance
                    matchFound = True
                End If
            End If
        Next j
    Next i

    ' マッチが見つかった場合、最も近い値を返す
    If matchFound Then
        CustomXLOOKUP = closestMatch
    Else
        ' マッチが見つからなかった場合、デフォルト値またはエラー値を返す
        If IsMissing(defaultValue) Then
            CustomXLOOKUP = CVErr(xlErrNA)
        Else
            CustomXLOOKUP = defaultValue
        End If
    End If
End Function

' GetValueFromReturnArray関数: 指定された位置にある戻り値配列から値を取得
Function GetValueFromReturnArray(returnArray As Range, i As Long, j As Long) As Variant
    ' 戻り値配列が複数の行を持つ場合、同じ行から値を取得
    If returnArray.Rows.Count > 1 Then
        GetValueFromReturnArray = returnArray.Cells(i, 1).Value
    ' 戻り値配列が一行のみの場合、同じ列から値を取得
    Else
        GetValueFromReturnArray = returnArray.Cells(1, j).Value
    End If
End Function
'
'

Option Explicit

' CustomXLOOKUP関数

Function CustomXLOOKUP(lookupValue As Variant, lookupArray As Range, returnArray As Range, _

Optional defaultValue As Variant, _

Optional searchDirection As String = "forward", _

Optional matchMode As String = "exact") As Variant

Dim i As Long, j As Long

Dim matchFound As Boolean

Dim closestMatch As Variant

Dim closestDistance As Double

matchFound = False

closestDistance = 1E+308 ' 最短距離の初期値を非常に大きな数に設定

' lookupArrayの各セルをループして検索値を探す

For i = 1 To lookupArray.Rows.Count

For j = 1 To lookupArray.Columns.Count

Dim cellValue As Variant

cellValue = lookupArray.Cells(i, j).Value

' 完全一致検索の場合

If matchMode = "exact" And cellValue = lookupValue Then

' 戻り値配列から対応する値を取得して関数を終了

CustomXLOOKUP = GetValueFromReturnArray(returnArray, i, j)

matchFound = True

Exit Function

' 近似一致検索の場合（数値のみ）

ElseIf matchMode = "approximate" And IsNumeric(cellValue) And IsNumeric(lookupValue) Then

' 検索値との距離を計算

Dim distance As Double

distance = Abs(cellValue - lookupValue)

' 最短距離よりも小さい場合、最短距離と最も近い値を更新

If distance < closestDistance Then

closestMatch = GetValueFromReturnArray(returnArray, i, j)

closestDistance = distance

matchFound = True

End If

Next j

Next i

' マッチが見つかった場合、最も近い値を返す

If matchFound Then

CustomXLOOKUP = closestMatch

Else

' マッチが見つからなかった場合、デフォルト値またはエラー値を返す

If IsMissing(defaultValue) Then

CustomXLOOKUP = CVErr(xlErrNA)

Else

CustomXLOOKUP = defaultValue

End If

End Function

' GetValueFromReturnArray関数: 指定された位置にある戻り値配列から値を取得

Function GetValueFromReturnArray(returnArray As Range, i As Long, j As Long) As Variant

' 戻り値配列が複数の行を持つ場合、同じ行から値を取得

If returnArray.Rows.Count > 1 Then

GetValueFromReturnArray = returnArray.Cells(i, 1).Value

' 戻り値配列が一行のみの場合、同じ列から値を取得

Else

GetValueFromReturnArray = returnArray.Cells(1, j).Value

End If

End Function

今回は、EXCEL VBAでカスタマイズされた検索関数「CustomXLOOKUP関数」の作り方と活用法について詳しく解説しました。この関数は、標準のXLOOKUP関数を基にしつつ、複雑で多様なデータ検索ニーズに対応するためのカスタマイズが施されています。実務での様々なシナリオを想定した使い方を紹介し、どのようにしてデータ分析やレポート作成の効率を上げることができるかを示しました。CustomXLOOKUP関数を活用することで、事務所業務をはじめとする多くのシーンでデータ検索の柔軟性と効率性を高めることが可能です。これからもEXCEL VBAを用いたカスタマイズに挑戦し、業務プロセスの改善を目指していきましょう。

最後まで、ご覧いただきまして誠に有難うございました。
また、VBAに関するテクニックや便利な手法などをこのサイトに掲載していきますので、定期的に参照していただけると幸いです。

VBAプログラム（テクニック）EXCEL, VBA