[已解决]机构间关系的分类汇总【更新问题】

richalken

需要用VBA计算两个机构间关系的分类汇总，详细见附件。

其实通过Excel的界面点击鼠标也可以完成的，但是步骤太多太复杂，而且有多个excel文件需要统计，请大神出手相助，谢谢啦！！！

【问题已更新，感谢 蓝桥玄霜 的提醒谢谢。】

最佳答案

月排行榜 / 总排行榜

dsmch

2015-9-20 17:10

………………

跳转到最佳答案楼层

蓝桥玄霜

看不懂你的附件，不懂你想要做什么。

richalken

蓝桥玄霜 发表于 2015-9-20 11:44
看不懂你的附件，不懂你想要做什么。

感谢您的提醒，是我复制数据匆忙中出了问题，问题已更新，谢谢！

也希望您不吝赐教{:041:}{:091:}

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, d, i&,  s&, n&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("a1").CurrentRegion
   
5. ReDim brr(1 To UBound(arr), 1 To 3)
   
6. For i = 2 To UBound(arr)
   
7.     zf = arr(i, 1) & "," & arr(i, 3)
   
8.     If Not d.exists(zf) Then
   
9.         s = s + 1
   
10.         d(zf) = s
    
11.         brr(s, 1) = arr(i, 1)
    
12.         brr(s, 2) = arr(i, 3)
    
13.         brr(s, 3) = 1
    
14.     Else
    
15.         n = d(zf)
    
16.         brr(n, 3) = brr(n, 3) + 1
    
17.     End If
    
18. Next
    
19. [h:j] = ""
    
20. [h1:j1] = Array("机构简称", "联系机构", "紧密度")
    
21. Range("h2").Resize(s, 3) = brr
    
22. End Sub

复制代码

dsmch

………………

richalken

dsmch 发表于 2015-9-20 17:10
………………

感谢大神，学习了，附件的代码这么精简就解决了我的大问题，我仔细学习一下，不懂的向您请教。

再次感谢！！！{:11:}{:11:}{:11:}