[已解决]如何求号段（有附件了）

灿烂事业

各位大侠：
       我是一名高中老师，经常组织年级的期中期末考试，安排考场，附件中的表就是期中考试考场设置表，我想再弄一份各考场号段表，用于布置考场，如何求得各考场考号的起止号码（号段）
肯定大家帮忙！

最佳答案

月排行榜 / 总排行榜

爱疯

2013-4-21 22:23

Sub Click()
    Dim A, B, d, i%, s%
    A = Range("a1").CurrentRegion
    ReDim B(1 To UBound(A), 1 To 3)
    Set d = CreateObject("scripting.dictionary")
    s = s + 1
    For i = 2 To UBound(A)
        If d.exists(A(i, 4)) = False Then s = s + 1: d(A(i, 4)) = s
        
        B(s, 1) = A(i, 4)
        
        If B(s, 2) = 0 Then B(s, 2) = A(i, 1)
        If B(s, 2) > A(i, 1) Then B(s, 2) = A(i, 1)
        
        If B(s, 3) = 0 Then B(s, 2) = A(i, 1)
        If B(s, 3) < A(i, 1) Then B(s, 3) = A(i, 1)
    Next i
    B(1, 1) = "考场": B(1, 2) = "开始号": B(1, 3) = "结束号"
    [G1].Resize(s, 3) = B
End Sub
第二学期期中考试3.rar (30.51 KB, 下载次数: 14)

2013-4-21 22:23 上传

点击文件名下载附件


我粗心忘加了，改过来了

跳转到最佳答案楼层

1032446692

没看懂你想达到什么目的

爱疯

1. Sub Click()
   
2.     Dim A, B, d, i%, s%
   
3.     A = Range("a1").CurrentRegion
   
4.     ReDim B(1 To UBound(A), 1 To 3)
   
5.     Set d = CreateObject("scripting.dictionary")
   
6. 
   
7.     For i = 2 To UBound(A)
   
8.         If d.exists(A(i, 4)) = False Then s = s + 1: d(A(i, 4)) = s
   
9.         
   
10.         B(s, 1) = A(i, 4)
    
11.         
    
12.         If B(s, 2) = 0 Then B(s, 2) = A(i, 1)
    
13.         If B(s, 2) > A(i, 1) Then B(s, 2) = A(i, 1)
    
14.         
    
15.         If B(s, 3) = 0 Then B(s, 2) = A(i, 1)
    
16.         If B(s, 3) < A(i, 1) Then B(s, 3) = A(i, 1)
    
17.     Next i
    
18.     B(1, 1) = "考场": B(1, 2) = "开始号": B(1, 3) = "结束号"
    
19.     [G1].Resize(s, 3) = B
    
20. End Sub
    

复制代码

第二学期期中考试2.rar (30.25 KB, 下载次数: 9)

2013-4-21 13:02 上传

点击文件名下载附件

gaogege852

爱疯 发表于 2013-4-21 13:02

怎么只能从第266行开始？前面265人就没有考场和起止号

灿烂事业

爱疯 发表于 2013-4-21 13:02

老师，太棒了，帮我解决了大问题，我还有个小问题，就是在“科技五楼”这个考场的号段怎么没有（应该是1-265）

gaogege852

如果在D2中没有任何数据的时候就可以从D3考场开始了

爱疯

Sub Click()
    Dim A, B, d, i%, s%
    A = Range("a1").CurrentRegion
    ReDim B(1 To UBound(A), 1 To 3)
    Set d = CreateObject("scripting.dictionary")
    s = s + 1
    For i = 2 To UBound(A)
        If d.exists(A(i, 4)) = False Then s = s + 1: d(A(i, 4)) = s
        
        B(s, 1) = A(i, 4)
        
        If B(s, 2) = 0 Then B(s, 2) = A(i, 1)
        If B(s, 2) > A(i, 1) Then B(s, 2) = A(i, 1)
        
        If B(s, 3) = 0 Then B(s, 2) = A(i, 1)
        If B(s, 3) < A(i, 1) Then B(s, 3) = A(i, 1)
    Next i
    B(1, 1) = "考场": B(1, 2) = "开始号": B(1, 3) = "结束号"
    [G1].Resize(s, 3) = B
End Sub
第二学期期中考试3.rar (30.51 KB, 下载次数: 14)

2013-4-21 22:23 上传

点击文件名下载附件


我粗心忘加了，改过来了

灿烂事业

谢谢爱疯老师，真的十分感谢！