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

kuangben8

chxw68 发表于 2018-11-19 09:09

老师，这样的问题不用字典嵌套能做出来吗？我尝试使用数组加字典解决，但是没成功！

kuangben8

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

老师，我采用一个字典反复使用，配合数组嵌套也可以实现这个汇总功能了。。

1. Sub kuangben8()
   
2.     Dim arr, m%, n%, i%, j%, brr, crr, drr, err, s, k%, l%
   
3.     Dim dic As Object
   
4.     Set dic = CreateObject("Scripting.Dictionary")
   
5.     arr = Range("A1").CurrentRegion
   
6.     For m = 2 To UBound(arr, 1)
   
7.         dic(arr(m, 1)) = ""   '获取不重复的会员昵称
   
8.     Next
   
9.     brr = dic.keys
   
10.     dic.RemoveAll    '清空字典内容，后续继续使用
    
11.     ReDim crr(1 To UBound(brr) + 1)
    
12.     For m = 1 To UBound(brr) + 1
    
13.         For n = 2 To UBound(arr, 1)
    
14.             If arr(n, 1) = brr(m - 1) Then
    
15.                 dic(arr(n, 2)) = ""
    
16.             End If
    
17.         Next
    
18.         crr(m) = dic.keys  '将关键字赋给数组的某一个元素，此时一个元素也是一个数组。
    
19.         dic.RemoveAll   '清空字典内容，后续继续使用。
    
20.     Next
    
21.     ReDim drr(1 To UBound(brr) + 1)
    
22.     For m = 1 To UBound(crr)
    
23.         drr(m) = crr(m)
    
24.         For n = 1 To UBound(crr(m)) + 1   '对数组的一个元素(也是数组)进行循环。
    
25.             For i = 1 To UBound(brr) + 1
    
26.                 For j = 2 To UBound(arr, 1)
    
27.                     If arr(j, 1) = brr(i - 1) Then
    
28.                         If arr(j, 2) = crr(m)(n - 1) Then
    
29.                             dic(arr(j, 3)) = ""
    
30.                         End If
    
31.                     End If
    
32.                 Next j
    
33.                 If dic.Count > 0 Then
    
34.                     drr(m)(n - 1) = dic.keys
    
35.                 End If
    
36.                 Rem 采用数组嵌套的方式实现多维数组的功能！
    
37.                 dic.RemoveAll      '清空字典内容，后续继续使用。
    
38.             Next i
    
39.         Next n
    
40.     Next m
    
41.     j = 0
    
42.     ReDim err(1 To UBound(brr) + 1, 1 To 2)
    
43.     For m = 1 To UBound(brr) + 1
    
44.         j = j + 1
    
45.         s = "您的订单发货快递为:"
    
46.         For n = 1 To UBound(crr(m)) + 1
    
47.             s = s & "订单号:" & crr(m)(n - 1) & ","
    
48.             For i = 1 To UBound(drr(m)(n - 1)) + 1
    
49.                 s = s & drr(m)(n - 1)(i - 1) & ":"
    
50.                 For k = 2 To UBound(arr)
    
51.                     If arr(k, 1) = brr(m - 1) And arr(k, 2) = crr(m)(n - 1) And arr(k, 3) = drr(m)(n - 1)(i - 1) Then
    
52.                         l = l + 1
    
53.                         s = s & IIf(l <> 1, "、", "") & arr(k, 4)
    
54.                     End If
    
55.                 Next
    
56.                 s = s & ";"
    
57.                 l = 0
    
58.             Next
    
59.         Next
    
60.         err(m, 1) = brr(m - 1)
    
61.         err(m, 2) = Left(s, InStrRev(s, ";") - 1) & "。"
    
62.     Next
    
63.     Range("F2:G" & Cells(Rows.Count, 7).End(3).Row + 1).ClearContents
    
64.     Range("F2").Resize(UBound(err, 1), 2) = err
    
65. End Sub

复制代码

LMY123

字典与数组嵌套

abc123281

chxw68 发表于 2018-11-19 09:09

很好的字典嵌套学习例程