[已解决]请教怎样编写VBA码实现自动编号功能

mengcao888

请教，怎样编写VBA码，实现自动编号功能，具体要求见附件中，

最佳答案

月排行榜 / 总排行榜

爱疯

2013-4-13 00:46

1. Sub test()
   
2.     Dim A, B(1 To 99), i%, j%
   
3.     A = Sheet1.Range("a1").CurrentRegion
   
4.     For i = 2 To UBound(A)
   
5.         B(A(i, 2)) = B(A(i, 2)) + 1
   
6.     Next i
   
7. 
   
8.     For i = 1 To UBound(B)
   
9.         If B(i) > 3 Then
   
10.             j = j + 1
    
11.             B(i) = j
    
12.         Else
    
13.             B(i) = 0
    
14.         End If
    
15.     Next i
    
16. 
    
17.     For i = 2 To UBound(A)
    
18.         If B(A(i, 2)) > 0 Then A(i, 6) = B(A(i, 2))
    
19.     Next i
    
20.     [f1].Resize(UBound(A)) = Application.Index(A, 0, 6)
    
21. End Sub
    
22. 
    

复制代码

自动分箱号2.rar (11.32 KB, 下载次数: 22)

2013-4-13 00:46 上传

点击文件名下载附件

跳转到最佳答案楼层

mengcao888

不知道是否已说明清楚，也许是太复杂了，这个问题我想了很久，也没有做出来。不知那位高手能否帮忙解决？先谢谢了。

爱疯

1. Sub test()
   
2.     Dim A, B(1 To 99), i%, j%
   
3.     A = Sheet1.Range("a1").CurrentRegion
   
4.     For i = 2 To UBound(A)
   
5.         B(A(i, 2)) = B(A(i, 2)) + 1
   
6.     Next i
   
7. 
   
8.     For i = 1 To UBound(B)
   
9.         If B(i) > 3 Then
   
10.             j = j + 1
    
11.             B(i) = j
    
12.         Else
    
13.             B(i) = 0
    
14.         End If
    
15.     Next i
    
16. 
    
17.     For i = 2 To UBound(A)
    
18.         If B(A(i, 2)) > 0 Then A(i, 6) = B(A(i, 2))
    
19.     Next i
    
20.     [f1].Resize(UBound(A)) = Application.Index(A, 0, 6)
    
21. End Sub
    
22. 
    

复制代码

自动分箱号2.rar (11.32 KB, 下载次数: 22)

2013-4-13 00:46 上传

点击文件名下载附件

mengcao888

”爱疯“太强了，佩服，非常感谢，有机会要好好向您学习。