excel怎么根据第一列的条件筛选出后几列的对应值

yinj0

各位大侠帮忙看看
vba怎么实现
表格右边是最终需要实现的结果


excel怎么根据第一列的条件筛选出后几列的对应值

kuangben8

数组加字典的基本应用！上传附件吧，我来帮你做！

yinj0

谢谢！谢谢！谢谢！谢谢！

yinj0

kuangben8 发表于 2018-11-15 12:44
数组加字典的基本应用！上传附件吧，我来帮你做！

谢谢大师！谢谢大师！

kuangben8

yinj0 发表于 2018-11-15 14:07
谢谢大师！谢谢大师！

好像有点打脸了！我要思考思考。。。。

chxw68

1. Sub tet()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   With Worksheets("sheet1")
   
7.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
8.     arr = .Range("a2:d" & r)
   
9.     For i = 1 To UBound(arr)
   
10.       If Not d.exists(arr(i, 1)) Then
    
11.         Set d(arr(i, 1)) = CreateObject("scripting.dictionary")
    
12.       End If
    
13.       If Not d(arr(i, 1)).exists(arr(i, 2)) Then
    
14.         Set d(arr(i, 1))(arr(i, 2)) = CreateObject("scripting.dictionary")
    
15.       End If
    
16.       If Not d(arr(i, 1))(arr(i, 2)).exists(arr(i, 3)) Then
    
17.         m = 1
    
18.         ReDim brr(1 To m)
    
19.       Else
    
20.         brr = d(arr(i, 1))(arr(i, 2))(arr(i, 3))
    
21.         m = UBound(brr) + 1
    
22.         ReDim Preserve brr(1 To m)
    
23.       End If
    
24.       brr(m) = arr(i, 4)
    
25.       d(arr(i, 1))(arr(i, 2))(arr(i, 3)) = brr
    
26.     Next
    
27.   End With
    
28.   With Worksheets("sheet2")
    
29.     .UsedRange.Offset(1, 0).Clear
    
30.     m = 1
    
31.     For Each aa In d.keys
    
32.       m = m + 1
    
33.       ss = "您的订单发货快递为："
    
34.       For Each bb In d(aa).keys
    
35.         ss = ss & "订单号" & bb & "，"
    
36.         For Each cc In d(aa)(bb).keys
    
37.           ss = ss & cc & "："
    
38.           brr = d(aa)(bb)(cc)
    
39.           For j = 1 To UBound(brr)
    
40.             ss = ss & IIf(j <> 1, "、", "") & brr(j)
    
41.           Next
    
42.           ss = ss & "；"
    
43.         Next
    
44.       Next
    
45.       .Cells(m, 1) = aa
    
46.       .Cells(m, 2) = ss
    
47.     Next
    
48.   End With
    
49. End Sub
    

复制代码

chxw68

详见附件。

kuangben8

chxw68 发表于 2018-11-19 09:10
详见附件。

老师，这是不是涉及到字典嵌套三级嵌套了？

chxw68

kuangben8 发表于 2018-11-19 13:59
老师，这是不是涉及到字典嵌套三级嵌套了？

是这样的。

yinj0

chxw68 发表于 2018-11-19 09:10
详见附件。

感谢，感谢，成功了！