[已解决]编号自动展开

billyzhang0609

求编号自动展开的方法：

如附件：

最佳答案

月排行榜 / 总排行榜

Zipall

2013-12-21 14:56

1. Sub test()
   
2.     arr = Range("A2").CurrentRegion
   
3.     n = 2
   
4.     Range("g2:h65536").ClearContents
   
5.     For r = 2 To UBound(arr)
   
6.         t = Split(arr(r, 1), "-")(0)
   
7.         With Cells(n, 6)
   
8.             .Value = t
   
9.             .AutoFill .Resize(arr(r, 2))
   
10.             .Offset(, 1).Resize(arr(r, 2)).Value = 1
    
11.             .Offset(, 2).Resize(arr(r, 2)).Value = arr(r, 3) / arr(r, 2)
    
12.         End With
    
13.         n = n + Cells(r, 2).Value
    
14.     Next
    
15. End Sub
    

复制代码

跳转到最佳答案楼层

冥王

最好不要重复发帖

hwc2ycy

VBA题？
好像以前就做过类似的题。

Zipall

1. Sub test()
   
2.     arr = Range("A2").CurrentRegion
   
3.     n = 2
   
4.     Range("g2:h65536").ClearContents
   
5.     For r = 2 To UBound(arr)
   
6.         t = Split(arr(r, 1), "-")(0)
   
7.         With Cells(n, 6)
   
8.             .Value = t
   
9.             .AutoFill .Resize(arr(r, 2))
   
10.             .Offset(, 1).Resize(arr(r, 2)).Value = 1
    
11.             .Offset(, 2).Resize(arr(r, 2)).Value = arr(r, 3) / arr(r, 2)
    
12.         End With
    
13.         n = n + Cells(r, 2).Value
    
14.     Next
    
15. End Sub
    

复制代码

billyzhang0609

Zipall 发表于 2013-12-21 14:56

先顶一下，待我慢慢学习。

billyzhang0609

Zipall 发表于 2013-12-21 14:56

不过如果队伍里面有一个编号为“DD00001”也就是不带 “-” 的，程序就出错了。

billyzhang0609

billyzhang0609 发表于 2013-12-21 15:31
不过如果队伍里面有一个编号为“DD00001”也就是不带 “-” 的，程序就出错了。

   我知道了，  For r = 1 To UBound(arr)

billyzhang0609

billyzhang0609 发表于 2013-12-21 15:37
我知道了，  For r = 1 To UBound(arr)

不是修改For r = 1 To UBound(arr)

而是在
t = Split(arr(r, 1), "-")(0)

前面加ON ERROR resume next