[已解决]字典法查找

759857387

字典法查找.rar (3.35 KB, 下载次数: 18)

2015-1-22 22:00 上传

点击文件名下载附件
根据AA列“级别”查找“编号”，结果写入表2第10行以下，希望是字典法

最佳答案

月排行榜 / 总排行榜

dsmch

2015-1-23 09:59

1. Sub Macro1()
   
2. Dim arr, d, i&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Sheet1.Activate
   
5. arr = Range("a2:aa" & Range("aa65536").End(xlUp).Row)
   
6. n = UBound(arr, 2)
   
7. For i = 1 To UBound(arr)
   
8.     If Not d.exists(arr(i, n)) Then
   
9.         d(arr(i, n)) = arr(i, 1)
   
10.     Else
    
11.         d(arr(i, n)) = d(arr(i, n)) & "," & arr(i, 1)
    
12.     End If
    
13. Next
    
14. Sheet2.[a11].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
    
15. End Sub

复制代码

跳转到最佳答案楼层

爱疯

最好上传部分实际数据，并模拟出部分的结果。

说明写在帖子里，发截图，有利于更快得到帮助

dsmch

1. Sub Macro1()
   
2. Dim arr, d, i&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Sheet1.Activate
   
5. arr = Range("a2:aa" & Range("aa65536").End(xlUp).Row)
   
6. n = UBound(arr, 2)
   
7. For i = 1 To UBound(arr)
   
8.     If Not d.exists(arr(i, n)) Then
   
9.         d(arr(i, n)) = arr(i, 1)
   
10.     Else
    
11.         d(arr(i, n)) = d(arr(i, n)) & "," & arr(i, 1)
    
12.     End If
    
13. Next
    
14. Sheet2.[a11].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
    
15. End Sub

复制代码