Mlookup函数(任意位置查找和多条件查找升级版)

Function Mlookup(rg, rgs As Range, L As Integer, M As Integer)

Dim arr1, ARR2, 列数

Dim R, n, K, X, cc, sr As String

arr1 = rg.Value

ARR2 = rgs

If VBA.IsArray(arr1) Then

For Each R In arr1

If R <> "" Then

cc = cc & R

列数 = 列数 + 1

End If

Next R

Else

cc = arr1

End If

If M > 0 Then '非查找最后一个

For X = 1 To UBound(ARR2)

sr = ""

If 列数 > 1 Then

For q = 1 To 列数

sr = sr & ARR2(X, q)

Next q

Else

sr = ARR2(X, 1)

End If

If sr = cc Then

K = K + 1

If K = M Then

Mlookup = ARR2(X, L)

Exit Function

End If

End If

Next X

ElseIf M = -1 Then '查找所有值

For X = 1 To UBound(ARR2)

sr = ""

If 列数 > 1 Then

For q = 1 To 列数

sr = sr & ARR2(X, q)

Next q

Else

sr = ARR2(X, 1)

End If

If sr = cc Then

Mlookup = Mlookup & "," & ARR2(X, L)

End If

Next X

Mlookup = Right(Mlookup, Len(Mlookup) - 1)

Exit Function

Else '查找最后一个

For X = UBound(ARR2) To 1 Step -1

sr = ""

If 列数 > 1 Then

For q = 1 To 列数

sr = sr & ARR2(X, q)

Next q

Else

sr = ARR2(X, 1)

End If

If sr = cc Then

Mlookup = ARR2(X, L)

Exit Function

End If

Next X

End If

Mlookup = ""

End Function

End Function