Excel自作 VBA 関数
特定のデータを検索するVLOOKUP関数に複数条件で検索する機能を追加した関数です。
これを使えばSUMIFS やCOUNTIFSなどと同じようにVLOOKUPを複数条件で検索することが可能です。
※検索の型は完全一致、検索条件は10個までとなります。
VBEの標準モジュールに下のコードを登録して「Excelマクロ有効フォーム」で保存してください。
関数の登録方法は⇒♯000 ユーザー定義関数を登録する方法
登録されたら、シート上からユーザー関数「VLOOKUP2」が使用できます。
使い方は
ワークシート上で = VLOOKUPS(範囲,列番号,検索列番号1,検索値1,[検索列番号2],[検索値2],[検索列番号3],[検索値3]～,[検索列番号10],[検索値10])の関数として使用することで、 選択範囲より左の列の値を抽出できます。
VLOOKUPS(範囲,列番号,検索列番号1,検索値1,[検索列番号2],[検索値2],[検索列番号3],[検索値3]～,[検索列番号10],[検索値10])
特定のデータを検索するVLOOKUP関数で複数条件で検索する関数。
※検索の型は完全一致（近似値は求めれません）、検索条件は10個までとなります。
検索列より右列を抽出する場合は列番号、左列を検索する場合は－（マイナス）の列番号を指定する。
[例]
VLOOKUPS(C1:E5,3,1,2,2,”大阪府”)→「C1:E5」の検索範囲、選択範囲内の表示する列番号「3列目」、検索条件1の列「1列目」、検索条件1の検索値「2」、検索条件2の列「2列目」、検索条件2の検索値「大阪」
VLOOKUPS(C1:E5,3,1,2,2,”大阪府”)→大阪市
Function VLOOKUPS(Select_Range, Col_index As Long, Se_Col1 As Long, Se_Val1, Optional Se_Col2 As Long, Optional Se_Val2, _
Optional Se_Col3 As Long, Optional Se_Val3, Optional Se_Col4 As Long, Optional Se_Val4, _
Optional Se_Col5 As Long, Optional Se_Val5, Optional Se_Col6 As Long, Optional Se_Val6, _
Optional Se_Col7 As Long, Optional Se_Val7, Optional Se_Col8 As Long, Optional Se_Val8, _
Optional Se_Col9 As Long, Optional Se_Val9, Optional Se_Col10 As Long, Optional Se_Val10)
'特定のデータを検索するVLOOKUP関数で複数条件で検索する関数。
'通常最左列の条件のみで検索するVLOOKUP関数を複数列に検索条件を設定して検索
'できます。
'VLOOKUPS(範囲,列番号,検索列番号1,検索値1,[検索列番号2],[検索値2],[検索列番号3],[検索値3]～,[検索列番号10],[検索値10])
'VLOOKUPS(C1:E5,3,1,2,2,"大阪府")→「C1:E5」の検索範囲、選択範囲内の表示する列番号「3列目」、検索条件1の列「1列目」、
'検索条件1の検索値「2」、検索条件2の列「2列目」、検索条件2の検索値「大阪」
'VLOOKUPS(C1:E5,3,1,2,2,"大阪府")→大阪市
Dim Se_Table As Variant
Dim Match_Table As Variant
Dim Value_Table(1 To 10, 1 To 2) As Variant
Dim RowN As Long
Dim Se_Col As Long
Dim Se_Val As Variant
Dim i1 As Long
Dim i2 As Long
Dim i3 As Long
Dim i4 As Long
Value_Table(1, 1) = Se_Col1: Value_Table(1, 2) = Se_Val1
Value_Table(2, 1) = Se_Col2: Value_Table(2, 2) = Se_Val2
Value_Table(3, 1) = Se_Col3: Value_Table(3, 2) = Se_Val3
Value_Table(4, 1) = Se_Col4: Value_Table(4, 2) = Se_Val4
Value_Table(5, 1) = Se_Col5: Value_Table(5, 2) = Se_Val5
Value_Table(6, 1) = Se_Col6: Value_Table(6, 2) = Se_Val6
Value_Table(7, 1) = Se_Col7: Value_Table(7, 2) = Se_Val7
Value_Table(8, 1) = Se_Col8: Value_Table(8, 2) = Se_Val8
Value_Table(9, 1) = Se_Col9: Value_Table(9, 2) = Se_Val9
Value_Table(10, 1) = Se_Col10: Value_Table(10, 2) = Se_Val10
On Error GoTo EXITFUN
Se_Table = Select_Range
RowN = UBound(Se_Table, 1)
ReDim Match_Table(RowN)
For i = 1 To RowN
Match_Table(i) = 0
Next
For i1 = 1 To 10
Se_Col = Value_Table(i1, 1)
Se_Val = Value_Table(i1, 2)
If Se_Col = 0 Then
Exit For
End If
For i2 = 1 To RowN
If Match_Table(i2) = 0 Then
If Se_Val <> Se_Table(i2, Se_Col) Then
Match_Table(i2) = 1
End If
End If
Next
Next
For i3 = 1 To RowN
If Match_Table(i3) = 0 Then
VLOOKUPS = Se_Table(i3, Col_index)
i4 = 1
Exit For
End If
Next
If i4 = 0 Then
VLOOKUPS = CVErr(xlErrNA)
End If
Exit Function
EXITFUN:
VLOOKUPS = CVErr(xlErrNA)
End Functionここで紹介したコード使用による損害に対しては一切責任は負えません。