[已解决]请帮忙写一个宏命令.

falcon9999

要求在表格中.已注明.谢谢.

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-7-12 14:53

最后几句可以改成这样，mid真方便。

1. For i = 1 To r
   
2.   Mid(brr(i, 2), 1, 1) = "'"
   
3. Next i
   
4. [l2].Resize(r, 2) = brr
   
5. End Sub

复制代码

跳转到最佳答案楼层

大灰狼1976

1. Sub aaa()
   
2. Dim arr, brr, i&, d As Object, r&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("f2:k" & [f65536].End(3).Row)
   
5. ReDim brr(1 To UBound(arr), 1 To 2)
   
6. For i = 1 To UBound(arr)
   
7.   If arr(i, 6) = "N" Then
   
8.     If Not d.exists(arr(i, 1)) Then
   
9.       r = r + 1
   
10.       d(arr(i, 1)) = r
    
11.       brr(r, 1) = arr(i, 1)
    
12.     End If
    
13.     brr(d(arr(i, 1)), 2) = brr(d(arr(i, 1)), 2) & "," & arr(i, 5)
    
14.   End If
    
15. Next i
    
16. For i = 1 To r
    
17.   brr(i, 2) = "'" & Mid(brr(i, 2), 2)
    
18. Next i
    
19. [l2].Resize(r, 2) = brr
    
20. End Sub

复制代码

chart888

见附件

大灰狼1976

最后几句可以改成这样，mid真方便。

1. For i = 1 To r
   
2.   Mid(brr(i, 2), 1, 1) = "'"
   
3. Next i
   
4. [l2].Resize(r, 2) = brr
   
5. End Sub

复制代码

chart888

chart888 发表于 2017-7-12 14:46
见附件

我看错问题了看大灰狼老师的答案吧

falcon9999

大灰狼1976 发表于 2017-7-12 14:53
最后几句可以改成这样，mid真方便。

感谢大灰狼老师的帮助.辛苦了.