想实现多对多的查询返回

nancy4929

各位大神，我附件里面的是我之前做了的一个三级下拉菜单，然后现在我想根据我选择下拉菜单的三个条件，从数据区返回后面几列的数据显示在查找区，也就是多列条件返回多列数据。
我试过用SQL，不过失败了，字典也不是很了解怎么写，所以想请教各位大大，谢谢！

chaohuahch

其实前面三项已经确定以后，后面的你用数组进行处理就可以了。

nancy4929

chaohuahch 发表于 2018-7-16 11:30
其实前面三项已经确定以后，后面的你用数组进行处理就可以了。

小白求指导，我之前有想过数组，但是不知道怎么写条件和对应的赋值。

chaohuahch

nancy4929 发表于 2018-7-16 11:41
小白求指导，我之前有想过数组，但是不知道怎么写条件和对应的赋值。

把你前面的三个数据连接起来。作为一整个字符串。然后另外一组数据的相应三项练起来作为一个字符创。然后进行判断，若相同。后面的数据也相同。

nancy4929

chaohuahch 发表于 2018-7-16 11:47
把你前面的三个数据连接起来。作为一整个字符串。然后另外一组数据的相应三项练起来作为一个字符创。然后 ...

大大，我试了很久，可是还是返回不了几列的数据，能帮我举个例子看看么，谢谢

nancy4929

自己顶顶，麻烦各位大神，谢谢

zhenghui13

是不是这个效果，请检查.

1. Sub Find_Data()
   
2. Dim m
   
3. Dim rng, iRow
   
4. Dim arr
   
5. Dim Sk1$, Sk2$
   
6. Dim i
   
7. arr = Sheets("数据区").UsedRange
   
8. With Sheet1
   
9.     iRow = .Cells(65536, 4).End(xlUp).Row
   
10.     For m = iRow To 3 Step -1
    
11.         rng = Range(Range("B" & m), Range("D" & m))
    
12.         If UBound(rng, 2) = 3 Then
    
13.             Sk1 = .Cells(m, 2) & "-" & .Cells(m, 3) & "-" & .Cells(m, 4)
    
14.             For i = 2 To UBound(arr)
    
15.                 Sk2 = arr(i, 1) & "-" & arr(i, 2) & "-" & arr(i, 3)
    
16.                 If Sk1 = Sk2 Then
    
17.                     .Cells(m, 5) = arr(i, 4)
    
18.                     .Cells(m, 6) = arr(i, 5)
    
19.                     .Cells(m, 7) = arr(i, 6)
    
20.                     .Cells(m, 8) = arr(i, 7)
    
21.                     Exit For
    
22.                 End If
    
23.             Next i
    
24.         End If
    
25.     Next m
    
26. End With
    
27. End Sub

复制代码

zopey

Public Myr&, d, k, Arr

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Row < 3 Or Target.Column = 1 Then Exit Sub
If Target.Column > 4 Then Exit Sub


Myr = Sheet2.[a65536].End(xlUp).Row
Arr = Sheet2.Range("a3:z" & Myr)
Set d = CreateObject("Scripting.Dictionary")

If Target <> "" Then
    If Target.Column = 2 Then
        For i = 1 To UBound(Arr)
            If Arr(i, 1) = Target.Value Then
                d(Arr(i, 2) & "") = ""
            End If
        Next i

        Target.Offset(0, 1).Select
        With Target.Offset(0, 1).Validation
            .Delete
            .Add Type:=xlValidateList, Formula1:=Join(d.keys, ",")
        End With
        d.RemoveAll
    ElseIf Target.Column = 3 Then
        For i = 1 To UBound(Arr)
            If Arr(i, 1) = Target.Offset(0, -1).Value And Arr(i, 2) = Target.Value Then
                d(Arr(i, 3) & "") = ""
            End If
        Next i

        Target.Offset(0, 1).Select
        With Target.Offset(0, 1).Validation
            .Delete
            .Add Type:=xlValidateList, Formula1:=Join(d.keys, ",")
        End With
        d.RemoveAll
    ElseIf Target.Column = 4 Then
        For i = 1 To UBound(Arr)
            If Arr(i, 1) = Target.Offset(0, -2).Value And Arr(i, 2) = Target.Offset(0, -1).Value And Arr(i, 3) = Target.Value Then
                Target.Offset(0, 1).Value = Arr(i, 4)
                Target.Offset(0, 2).Value = Arr(i, 5)
                Target.Offset(0, 3).Value = Arr(i, 6)
                Target.Offset(0, 4).Value = Arr(i, 7)
                Exit For
            End If
        Next i
    End If
End If

End Sub

3级菜单.zip (13.52 KB, 下载次数: 31)

2018-7-16 17:20 上传

点击文件名下载附件

lsc900707

nancy4929 发表于 2018-7-16 16:47
自己顶顶，麻烦各位大神，谢谢

写了一个字典的匹配过程，自己根据要求修改成工作表事件吧。

nancy4929

zopey 发表于 2018-7-16 17:20
Public Myr&, d, k, Arr

Private Sub Worksheet_Change(ByVal Target As Range)

谢谢大大，我按这个思路写的时候就一直offset的下标错误，现在可以继续学习了~