[已解决]求自动生成考场号？

eikok

求自动生成考场号？

最佳答案

月排行榜 / 总排行榜

xdragon

2014-2-25 17:53

1. Sub 生成考场号()
   
2.   Dim arr(), i&, cnt1&, cnt2&
   
3.   arr = Range("A2:B" & Cells(Rows.Count, 2).End(xlUp).Row).Value
   
4.   For i = 1 To IIf(UBound(arr) < 180, UBound(arr), 180)
   
5.      arr(i, 1) = (i - 1) \ 60 + 1 & "考场"
   
6.   Next
   
7.   If i > UBound(arr) Then Exit Sub
   
8.   For i = 181 To UBound(arr)
   
9.      arr(i, 1) = (i - 181) \ 42 + 4 & "考场"
   
10.   Next
    
11.   Range("A2").Resize(UBound(arr)) = arr
    
12. End Sub

复制代码

有点乱，重新整理下。。。

跳转到最佳答案楼层

xdragon

看楼下的 -。-

xdragon

不好意思，直接没注意你的第四条要求。。。看这个吧。。。

1. Sub 生成考场号()
   
2.   Dim arr(), i&, cnt1&, cnt2&
   
3.   arr = Range("A2:B" & Cells(Rows.Count, 2).End(xlUp).Row).Value
   
4.   For i = 1 To UBound(arr)
   
5.      If i < 180 Then
   
6.         arr(i, 1) = (i - 1) \ 60 + 1 & "考场"
   
7.      Else
   
8.         cnt2 = cnt2 + 1
   
9.         Do While cnt1 < 42 And i < UBound(arr) + 1
   
10.         cnt1 = cnt1 + 1
    
11.         arr(i, 1) = cnt2 + 3 & "考场"
    
12.         i = i + 1
    
13.         Loop
    
14.         cnt1 = 0: i = i - 1
    
15.      End If
    
16.   Next
    
17.   Range("A2").Resize(UBound(arr)) = arr
    
18. End Sub

复制代码

xdragon

1. Sub 生成考场号()
   
2.   Dim arr(), i&, cnt1&, cnt2&
   
3.   arr = Range("A2:B" & Cells(Rows.Count, 2).End(xlUp).Row).Value
   
4.   For i = 1 To IIf(UBound(arr) < 180, UBound(arr), 180)
   
5.      arr(i, 1) = (i - 1) \ 60 + 1 & "考场"
   
6.   Next
   
7.   If i > UBound(arr) Then Exit Sub
   
8.   For i = 181 To UBound(arr)
   
9.      arr(i, 1) = (i - 181) \ 42 + 4 & "考场"
   
10.   Next
    
11.   Range("A2").Resize(UBound(arr)) = arr
    
12. End Sub

复制代码

有点乱，重新整理下。。。

eikok

xdragon 发表于 2014-2-25 17:53
有点乱，重新整理下。。。

多谢{:1112:}

eikok

xdragon 发表于 2014-2-25 17:53
有点乱，重新整理下。。。

弱弱的问一下
考场那列直接出来为
01
02
03
04
05
06
07
08
09
10
的格式怎么设置？

xdragon

eikok 发表于 2014-2-26 09:12
弱弱的问一下
考场那列直接出来为
01

1. Sub 生成考场号()
   
2. 
   
3.   Dim arr(), i&, cnt1&, cnt2&
   
4. 
   
5.   arr = Range("A2:B" & Cells(Rows.Count, 2).End(xlUp).Row).Value
   
6. 
   
7.   For i = 1 To IIf(UBound(arr) < 180, UBound(arr), 180)
   
8. 
   
9.      arr(i, 1) ="'" & format((i - 1) \ 60 + 1,"00")
   
10. 
    
11.   Next
    
12. 
    
13.   If i > UBound(arr) Then Exit Sub
    
14. 
    
15.   For i = 181 To UBound(arr)
    
16. 
    
17.      arr(i, 1) ="'" &  format((i - 181) \ 42 + 4,"00")
    
18. 
    
19.   Next
    
20. 
    
21.   Range("A2").Resize(UBound(arr)) = arr
    
22. 
    
23. End Sub

复制代码

这样试试看

eikok

xdragon 发表于 2014-2-26 09:46
这样试试看

顶礼膜拜一下啊
大侠出手果然不凡