kurukuru-papaのブログ

主に、ソフトウェア開発に関連したメモを書き溜めたいと思います。

vlookup関数の拡張

Excelのvlookup関数は非常に便利でよく使用します。
でも時々、検索対象の列が1列目に固定されていることに不満を覚えることがありました。
その不満を解消すべく、vlookup関数の拡張版を作成してみました。
ついでに、検索方法も拡張してみました。

Option Explicit

' 拡張vlookup関数
'
' 標準のvlookup関数を機能拡張した様な関数です。
' 標準vlookup関数では、検索対象列は最も左側の列ですが、当関数では列を指定できます。
' 標準vlookup関数では、検索方法が2種類ですが、当関数では5種類指定できます。
'
' 引数
' 検索方法
'   1 - "より小さい" 検索値よりも小さい値の中で、最も大きい値を検索します。
'   2 - "以下" 検索値以下の値の中で、最も大きい値を検索します。
'   3 - "等しい" 検索値に一致する値を検索します。
'   4 - "以上" 検索値以上の値の中で、最も小さい値を検索します。
'   5 - "より大さい" 検索値よりも大きい値の中で、最も小さい値を検索します。
'
' 返却値
' 該当の値が見つからない場合、N/Aを返却します。
'
' 新規作成:2009/4/23
'
Public Function U_VLookUp(検索値 As Variant, 範囲 As Range, _
検索列番号 As Integer, 返却列番号 As Integer, 検索方法 As Integer) As Variant

    Dim min As Integer
    Dim max As Integer
    Dim row As Integer

    ' 初期化
    U_VLookUp = CVErr(xlErrNA)
    
    ' 引数チェック
    If 検索列番号 < 1 Or 範囲.Columns.Count < 検索列番号 Then
        Exit Function
    End If
    If 返却列番号 < 1 Or 範囲.Columns.Count < 返却列番号 Then
        Exit Function
    End If
    
    ' 検索
    min = 1
    max = 範囲.Rows.Count
    For row = min To max
        Select Case 検索方法
        Case 1
            ' "より小さい"
            If 範囲.Cells(row, 検索列番号).Value >= 検索値 Then
                row = row - 1
                Exit For
            End If
        Case 2
            ' "以下"
            If 範囲.Cells(row, 検索列番号).Value = 検索値 Then
                Exit For
            End If
            If 範囲.Cells(row, 検索列番号).Value > 検索値 Then
                row = row - 1
                Exit For
            End If
        Case 3
            ' "等しい"
            If 範囲.Cells(row, 検索列番号).Value = 検索値 Then
                Exit For
            End If
        Case 4
            ' "以上"
            If 範囲.Cells(row, 検索列番号).Value >= 検索値 Then
                Exit For
            End If
        Case 5
            ' "より大きい"
            If 範囲.Cells(row, 検索列番号).Value > 検索値 Then
                Exit For
            End If
        End Select
        
        If 検索方法 Then
            If 範囲.Cells(row, 検索列番号).Value > 検索値 Then
                row = row - 1
                Exit For
            End If
        Else
        End If
    Next
    
    ' 返却
    If row <= max Then
        U_VLookUp = 範囲.Cells(row, 返却列番号)
    End If

End Function