FC2ブログ

VLOOKUPS 関数。

2017–09–22 (Fri) 18:26
VLOOKUPS 関数。
Vlookups + 細かく指定 が出来る関数を作成いたしました。検索する文字列と列番号は、文字列、列番号、文字列、列番号の順番で入力してください。

通常のVlookupで複数条件検索の出来る関数です。今まではワイルドカードが使えなかったのですが、今回からワイルドカードが使える様になりました。*(アスタリスク)指定が出来ます。

Function VlookupShitei(範囲 As Range, 列番号 As Long, ParamArray 検索する文字列と列番号())
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, check As Long, ken As Variant
Dim RE, strPattern As String, msg As String, reMatch
Set RE = CreateObject("VBScript.RegExp")
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
ReDim ken(owari, UBound(検索する文字列と列番号) + 1)
If (UBound(検索する文字列と列番号) + 1) Mod 2 = 0 Then
Dim k As Integer
For i = 0 To UBound(検索する文字列と列番号) Step 2
strPattern = Replace(検索する文字列と列番号(i), "*", ".*")
With RE
.Pattern = strPattern
.IgnoreCase = True
.Global = True
For j = 1 To owari
On Error Resume Next
Set reMatch = .Execute(範囲(j, 検索する文字列と列番号(i + 1)))
On Error GoTo 0
If IsEmpty(reMatch) = False Then
If reMatch.Count > 0 Then
ken(j, i) = j
End If
End If

Next
End With

Next
For i = 0 To UBound(ken)
check = 0
For j = 0 To UBound(検索する文字列と列番号) + 1
If ken(i, j) <> "" Then
check = check + 1
End If
If check = (UBound(検索する文字列と列番号) + 1) / 2 Then
VlookupShitei = 範囲(i, 列番号)
Exit Function
End If
Next
Next
If IsEmpty(VlookupShitei) = True Then
VlookupShitei = ""
End If
Else
VlookupShitei = ""
End If


Set reMatch = Nothing
Set RE = Nothing
End Function


次は下から検索するUVlookupの指定バージョンです。

Function UVlookupShitei(範囲 As Range, 列番号 As Long, ParamArray 検索する文字列と列番号())
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, check As Long, ken As Variant
Dim RE, strPattern As String, msg As String, reMatch
Set RE = CreateObject("VBScript.RegExp")
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
ReDim ken(owari, UBound(検索する文字列と列番号) + 1)
If (UBound(検索する文字列と列番号) + 1) Mod 2 = 0 Then
Dim k As Integer
For i = 0 To UBound(検索する文字列と列番号) Step 2
strPattern = Replace(検索する文字列と列番号(i), "*", ".*")
With RE
.Pattern = strPattern
.IgnoreCase = True
.Global = True
For j = owari To 1 Step -1
On Error Resume Next
Set reMatch = .Execute(範囲(j, 検索する文字列と列番号(i + 1)))
On Error GoTo 0
If IsEmpty(reMatch) = False Then
If reMatch.Count > 0 Then
ken(j, i) = j
End If
End If

Next
End With

Next
For i = UBound(ken) To 0 Step -1
check = 0
For j = 0 To UBound(検索する文字列と列番号) + 1
If ken(i, j) <> "" Then
check = check + 1
End If
If check = (UBound(検索する文字列と列番号) + 1) / 2 Then
UVlookupShitei = 範囲(i, 列番号)
Exit Function
End If
Next
Next
If IsEmpty(UVlookupShitei) = True Then
UVlookupShitei = ""
End If
Else
UVlookupShitei = ""
End If
Set reMatch = Nothing
Set RE = Nothing
End Function

なかなか綺麗なマクロを作ることが出来ないのが悔しくて悲しいです。
エラー処理無し 条件が満たない場合は自動で空白になります。

VLOOKUPS 関数.docx

VLOOKUPS 関数.pdf
スポンサーサイト



« VlookupShitei を作ってみました | HOME |  setH(表示指定)関数を作成しました。 »

コメント

コメントの投稿

 
管理者にだけ表示

 | HOME | 

プロフィール

はる

Author:はる
FC2ブログへようこそ!

最新記事

最新コメント

フリーエリア

月別アーカイブ

カテゴリ

ブロとも申請フォーム

検索フォーム

RSSリンクの表示

リンク