多条件匹配

cjf1302

A列为项目名称，有10万行，B、C、D、E列内都是公式
在K列处是需要的项目，有多个项目
使用按钮
需要根据K列内容匹配A列读取相应的B、C、D、E列，并且仍保留是公式

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, br, i&, j&, k&
   
    ar = [A1].CurrentRegion.Value
    br = [K1].CurrentRegion.Value
    For i = 2 To UBound(br)
        For j = 2 To UBound(br, 2)
            ar(i, j) = Empty
        Next j
        For j = 2 To UBound(ar)
            If ar(j, 1) = br(i, 1) Then
                For k = 2 To UBound(br, 2)
                    br(i, k) = ar(j, k)
                Next k
                Exit For
            End If
        Next j
    Next i
   
    [K1].CurrentRegion.Clear
    [K1].Resize(UBound(br), UBound(br, 2)) = br
    Beep
End Sub

gwjkkkkk

请参考附件。。。

gwjkkkkk

L2=
=

1. VLOOKUP($K2,$A$1:$E$31,COLUMN()-10,0)

复制代码

quqiyuan

参与一下，仅供参考。。。

quqiyuan

代码如下。。。
Sub 按钮1_Click()
    Set d = CreateObject("scripting.dictionary")
    With Sheet1
        arr = .[a1].CurrentRegion.Formula
        brr = .Range("k1:k" & .Cells(.Rows.Count, "k").End(3).Row)
        For i = 2 To UBound(brr)
            d(brr(i, 1)) = Application.Index(arr, _
                Application.Match(brr(i, 1), Application.Index(arr, , 1), 0))
        Next
        [k2].Resize(d.Count, 5) = Application.Rept(d.items, 1)
    End With
    Set d = Nothing
    Beep
End Sub

ykcbf1100

参与一下，保留公式

ykcbf1100

参与一下。。。