国产一区二区欧美精品免费-欧美国产日韩在线视频-欧美亚洲国语精品一区二区-欧美激情五月综合啪啪-国产69精品麻豆久久久久-亚洲人成精品久久久久桥网站-欧美刺激肥熟在线视频-十七岁日本免费完整版BD-黑夜在线拖拽不卡第一页

mlookup公式以有人升級(jí)為比xlookup更為強(qiáng)大的wlookup

現(xiàn)將vba代碼上傳到網(wǎng)站上真心希望更新if函數(shù)與lookup函數(shù)sum函數(shù)因?yàn)橛泻芏啻笊穸紝⒐δ芗尤氲降桶姹镜膐ffice上所以更多的低版本office又有了新的生命，在此也感謝格子社區(qū)現(xiàn)將代碼呈上

Function Wlookup(V, vY, vh, Optional m)

 Dim arr, arr1, arr2()

 Dim k As Integer

 arr = vY

 arr1 = vh

       If UBound(arr1) = 1 Then

       arr1 = Application.Transpose(arr1)

       arr = Application.Transpose(arr)

       End If

ReDim arr2(1 To 1)

 For x = 1 To UBound(arr1)

    If arr(x, 1) = V Then

       Wlookup = arr1(x, 1)

       If IsMissing(m) Then

         Exit Function

       Else

        k = k + 1

        ReDim Preserve arr2(1 To k)

        arr2(k) = arr1(x, 1)

       End If

    End If

  Next x

  If m = 0 Then

    Wlookup = arr2(k)

  ElseIf m = -1 Then

   Wlookup = Join(arr2, ",")

  ElseIf m = -2 Then

   Wlookup = JS(V, vY, vh)

  Else

    Wlookup = arr2(m)

  End If

End Function

Function JS(J1, R1, R2) '取接近值

Dim Jarr1, Jarr2

Dim x

 Jarr1 = R1

 Jarr2 = R2

For x = 1 To UBound(Jarr1)

  If x + 1 > UBound(Jarr1) Then

       JS = Jarr2(x, 1)

       Exit Function

  ElseIf J1 >= Jarr1(x, 1) And J1 < Jarr1(x + 1, 1) Then

       JS = Jarr2(x, 1)

       Exit Function

  End If

Next x

End Function

說(shuō)實(shí)話本人學(xué)渣復(fù)制的代碼請(qǐng)各大神指正一下，希望可以更新一下mlookup這個(gè)老函數(shù)