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

 

 

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

 

 

 

 

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

 

 

 

'
' 変数宣言する
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関数で検索力を強化する方法！（オリジナル関数）

 

 

 

'
'
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
'
'