[已解决]如何根据村别找出社别

ycb20010823

如何写一段VBA代码，求出每个村里包含的社，谢谢

数据库是：A列和B列

想要得到F列和G列的效果

最佳答案

月排行榜 / 总排行榜

grf1973

2015-9-8 10:28

用“删除重复项”功能。至于代码。。。。看动画录个宏就OK了。

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, d, i&, s&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("a1").CurrentRegion
   
5. ReDim brr(1 To UBound(arr), 1 To 2)
   
6. For i = 1 To UBound(arr)
   
7.     zf = arr(i, 1) & "," & arr(i, 2)
   
8.     If Not d.exists(zf) Then
   
9.         s = s + 1
   
10.         d(zf) = ""
    
11.         brr(s, 1) = arr(i, 1)
    
12.         brr(s, 2) = arr(i, 2)
    
13.     End If
    
14. Next
    
15. Range("h1").Resize(s, 2) = brr
    
16. End Sub

复制代码

ycb20010823

dsmch 发表于 2015-9-8 05:49

感谢二楼的老师，效果很好，只是最上列，多出一行数据！还有，能不能不用字典，用常规代码呢？因为字典看不懂，也看不出来是怎么做到的。谢谢二楼的老师！！！

爱疯

Sub test()
    Rows(1).Insert
    [a1] = "字段名1": [b1] = "字段名2"
    Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("M1"), Unique:=True
    Rows(1).Delete
End Sub

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, i&, s&
   
3. arr = Range("a1").CurrentRegion
   
4. ReDim brr(1 To UBound(arr), 1 To 2)
   
5. For i = 1 To UBound(arr)
   
6.     If arr(i, 1) Like "*村" Then
   
7.         zf = arr(i, 1) & "," & arr(i, 2)
   
8.         If InStr(p, zf) = 0 Then
   
9.             p = p & zf
   
10.             s = s + 1
    
11.             brr(s, 1) = arr(i, 1)
    
12.             brr(s, 2) = arr(i, 2)
    
13.         End If
    
14.     End If
    
15. Next
    
16. Range("h1").Resize(s, 2) = brr
    
17. End Sub

复制代码

grf1973

用“删除重复项”功能。至于代码。。。。看动画录个宏就OK了。

ycb20010823

dsmch 博士研究生你好，你的字典功能实在强大，效果非常好，谢谢你对我的无私帮助；
爱疯 超级版主你好，你的代码非常很简单，谢谢你；
grf1973 硕士研究生你好，你的方法我认为最优秀，因为什么也不用，用鼠标指指点点，几下就解决问题了。

非常感谢上述三位老师的无私帮助！