求助！想输入一个值，自动例出数据源中的所有值！

wfxserver

各位老磊如标题。

请各位帮助一下！谢谢各位老大！

lsc900707

就一个简单的查询呀。

iwangyi

Sub CC()
N = 5
ARR = Range("A5").CurrentRegion
For J = 2 To UBound(ARR)
If ARR(J, 1) = Range("G5") Then
N = N + 1
Cells(N, "G") = Range("G5")
Cells(N, "H") = ARR(J, 2)
End If
Next
End Sub

everbest2015

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ar, r&, i&, br(), m&, s
    r = Cells(Rows.Count, "A").End(xlUp).Row
    ar = Range("a6").Resize(r - 5, 2)
    If Target.Count > 1 Then Exit Sub
    If Target.Address <> "$G$5" Then Exit Sub
    [G6].Resize(Rows.Count - 5, 2).ClearContents
    With Target
        For i = 1 To UBound(ar)
            s = ar(i, 1)
            If s <> "" Then
                If .Value = s Then
                    m = m + 1
                    ReDim Preserve br(1 To 2, 1 To m)
                    br(1, m) = ar(i, 1)
                    br(2, m) = ar(i, 2)
                End If
            End If
        Next
    End With
   If m = 0 Then MsgBox "未发现符合条件的数据!", , "退出": Exit Sub
   
   [G6].Resize(m, 2) = Application.Transpose(br)
End Sub

iwangyi

附件，请参考

wfxserver

iwangyi 发表于 2018-9-28 10:33
Sub CC()
N = 5
ARR = Range("A5").CurrentRegion

我的数据源在Sheet2中。我改不来。求助。

wfxserver

iwangyi老大，附数据  我改不来。不知道怎么改。

iwangyi

Arr=Sheet2.usedRange

lsc900707

wfxserver 发表于 2018-9-28 15:13
iwangyi老大，附数据  我改不来。不知道怎么改。

改不来就多”评分“呗！