[已解决]vba编码请各位大神帮忙

panda120

dsmch 发表于 2015-4-1 10:54
这样的话，代码代码改动如下

非常感谢！就是这个样子的！不过我后来尝试在原有代码上改范围出错了，能再帮我下吗？我重新上传附件。非常感谢！！！

panda120

大神帮我看下

panda120

dsmch 发表于 2015-4-1 10:54
这样的话，代码代码改动如下

附件在12；楼

dsmch

1. Sub Macro1()
   
2. Dim arr, d, i&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("b1").CurrentRegion
   
5. For i = 2 To UBound(arr)
   
6.     If arr(i, 3) = "" Then arr(i, 3) = "@"
   
7.     If Not d.exists(arr(i, 1)) Then
   
8.         d(arr(i, 1)) = arr(i, 3)
   
9.     Else
   
10.         If InStr("," & d(arr(i, 1)) & ",", "," & arr(i, 3) & ",") = 0 Then d(arr(i, 1)) = d(arr(i, 1)) & "," & arr(i, 3)
    
11.     End If
    
12. Next
    
13. a = d.keys
    
14. For i = 0 To d.Count - 1
    
15.     x = Split(d(a(i)), ",")
    
16.     d(a(i)) = UBound(x) + 1
    
17. Next
    
18. For i = 2 To UBound(arr)
    
19.     arr(i, 18) = d(arr(i, 1))
    
20. Next
    
21. Range("s1").Resize(UBound(arr)) = Application.Index(arr, 0, 18)
    
22. End Sub

复制代码

panda120

dsmch 发表于 2015-4-1 12:38

非常感谢！

panda120

dsmch 发表于 2015-4-1 12:38

大神能解释一下句子么，我查了一下发现还有错的，比如5行的返回数据是6了

panda120

dsmch 发表于 2015-4-1 12:38

大神，我抽了几组数据出错的，请帮忙看下原因出在哪里应该怎么改，谢谢

dsmch

d列包含西文逗号

1. Sub Macro1()
   
2. Dim arr, d, i&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("b1").CurrentRegion
   
5. For i = 2 To UBound(arr)
   
6.     If Not d.exists(arr(i, 1)) Then
   
7.         d(arr(i, 1)) = arr(i, 3)
   
8.     Else
   
9.         If InStr("|" & d(arr(i, 1)) & "|", "|" & arr(i, 3) & "|") = 0 Then d(arr(i, 1)) = d(arr(i, 1)) & "|" & arr(i, 3)
   
10.     End If
    
11. Next
    
12. a = d.keys
    
13. For i = 0 To d.Count - 1
    
14.     x = Split(d(a(i)), "|")
    
15.     d(a(i)) = UBound(x) + 1
    
16. Next
    
17. For i = 2 To UBound(arr)
    
18.     arr(i, 18) = d(arr(i, 1))
    
19. Next
    
20. Range("s1").Resize(UBound(arr)) = Application.Index(arr, 0, 18)
    
21. End Sub

复制代码

panda120

dsmch 发表于 2015-4-1 16:16
d列包含西文逗号

完美解决谢谢