[已解决]求助为什么生成试室号超过某值时会出现下越标界

qinhuan66

求助为什么生成试室号超过某值时会出现下越标界。谢谢，意思是K列没值时出错，有值时正常，能否在K列没值时弹出提示。谢谢
求助.rar (41.75 KB, 下载次数: 13)

2013-6-16 08:08 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-6-16 08:40

1. Private Sub CommandButton1_Click()
   
2.     Dim arr, arrTemp()
   
3.     Dim i As Long, j As Long
   
4.     Dim lLastRowD As Long
   
5.     Dim lLastRowK As Long
   
6.     Dim arrNO, lNO As Long
   
7. 
   
8.     arr = CheckInput
   
9.     If Not IsArray(arr) Then Exit Sub
   
10.     i = Cells(Rows.Count, "k").End(xlUp).Row
    
11.     arrNO = Range("k3:k" & i).Value
    
12.    
    
13.     Application.ScreenUpdating = False
    
14.     Application.DisplayAlerts = False
    
15.     Application.EnableEvents = False
    
16.     Columns("d:f").ClearContents
    
17.     Range("d2").Resize(, 3) = Array("试室号", "座位号", "准考证号")
    
18.     lLastRowK = Cells(Rows.Count, "k").End(xlUp).Row
    
19.     For i = 1 To UBound(arr)
    
20.         If Len(arr(i, 1)) Then
    
21.             lLastRowD = Cells(Rows.Count, "d").End(xlUp).Row + 1
    
22.             If lLastRowK - lLastRowD + 1 < arr(i, 2) Then MsgBox "K列数据不够": GoTo quit
    
23.             ReDim arrTemp(1 To arr(i, 2), 1 To 3)
    
24.             For j = 1 To arr(i, 2)
    
25.                 lNO = lNO + 1
    
26.                 arrTemp(j, 1) = Format(Val(arr(i, 1)), "'00")
    
27.                 arrTemp(j, 2) = Format(j, "'00")
    
28.                 arrTemp(j, 3) = Replace(arrNO(lNO, 1) & arrTemp(j, 1) & arrTemp(j, 2), "'", "")
    
29.                
    
30.             Next
    
31.             Cells(lLastRowD, "d").Resize(arr(i, 2), UBound(arrTemp, 2)).Value = arrTemp
    
32.         Else
    
33.             Exit For
    
34.         End If
    
35.     Next
    
36. quit:
    
37.     Application.ScreenUpdating = True
    
38.     Application.DisplayAlerts = True
    
39.     Application.EnableEvents = True
    
40. : Unload 生成试室座位号
    
41. End Sub

复制代码

跳转到最佳答案楼层

妞叫七七

能否在K列没值时弹出提示, .. 为什么不在前面加一个IF语句判断一下K值呢

qinhuan66

妞叫七七 发表于 2013-6-16 08:23
能否在K列没值时弹出提示, .. 为什么不在前面加一个IF语句判断一下K值呢

谢谢！应该怎么加呢？
Private Sub CommandButton1_Click()
    Dim arr, arrTemp()
    Dim i As Long, j As Long
    Dim lLastRow As Long
    Dim arrNO, lNO As Long

    arr = CheckInput
    If Not IsArray(arr) Then Exit Sub
    i = Cells(Rows.Count, "k").End(xlUp).Row
    arrNO = Range("k3:k" & i).Value

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Columns("d:f").ClearContents
    Range("d2").Resize(, 3) = Array("试室号", "座位号", "准考证号")

    For i = 1 To UBound(arr)
        If Len(arr(i, 1)) Then
            lLastRow = Cells(Rows.Count, "d").End(xlUp).Row + 1
            ReDim arrTemp(1 To arr(i, 2), 1 To 3)
            For j = 1 To arr(i, 2)
                lNO = lNO + 1
                arrTemp(j, 1) = Format(Val(arr(i, 1)), "'00")
                arrTemp(j, 2) = Format(j, "'00")
                arrTemp(j, 3) = Replace(arrNO(lNO, 1) & arrTemp(j, 1) & arrTemp(j, 2), "'", "")

            Next
            Cells(lLastRow, "d").Resize(arr(i, 2), UBound(arrTemp, 2)).Value = arrTemp
        Else
            Exit For
        End If
    Next

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
: Unload

hwc2ycy

IF判断嘛，亲。

妞叫七七

if application.counta(range("k:k"))=0

hwc2ycy

1. Private Sub CommandButton1_Click()
   
2.     Dim arr, arrTemp()
   
3.     Dim i As Long, j As Long
   
4.     Dim lLastRowD As Long
   
5.     Dim lLastRowK As Long
   
6.     Dim arrNO, lNO As Long
   
7. 
   
8.     arr = CheckInput
   
9.     If Not IsArray(arr) Then Exit Sub
   
10.     i = Cells(Rows.Count, "k").End(xlUp).Row
    
11.     arrNO = Range("k3:k" & i).Value
    
12.    
    
13.     Application.ScreenUpdating = False
    
14.     Application.DisplayAlerts = False
    
15.     Application.EnableEvents = False
    
16.     Columns("d:f").ClearContents
    
17.     Range("d2").Resize(, 3) = Array("试室号", "座位号", "准考证号")
    
18.     lLastRowK = Cells(Rows.Count, "k").End(xlUp).Row
    
19.     For i = 1 To UBound(arr)
    
20.         If Len(arr(i, 1)) Then
    
21.             lLastRowD = Cells(Rows.Count, "d").End(xlUp).Row + 1
    
22.             If lLastRowK - lLastRowD + 1 < arr(i, 2) Then MsgBox "K列数据不够": GoTo quit
    
23.             ReDim arrTemp(1 To arr(i, 2), 1 To 3)
    
24.             For j = 1 To arr(i, 2)
    
25.                 lNO = lNO + 1
    
26.                 arrTemp(j, 1) = Format(Val(arr(i, 1)), "'00")
    
27.                 arrTemp(j, 2) = Format(j, "'00")
    
28.                 arrTemp(j, 3) = Replace(arrNO(lNO, 1) & arrTemp(j, 1) & arrTemp(j, 2), "'", "")
    
29.                
    
30.             Next
    
31.             Cells(lLastRowD, "d").Resize(arr(i, 2), UBound(arrTemp, 2)).Value = arrTemp
    
32.         Else
    
33.             Exit For
    
34.         End If
    
35.     Next
    
36. quit:
    
37.     Application.ScreenUpdating = True
    
38.     Application.DisplayAlerts = True
    
39.     Application.EnableEvents = True
    
40. : Unload 生成试室座位号
    
41. End Sub

复制代码

hwc2ycy

K列数据不够用的时候，就不会再生成了。
没有精确到行，只精确组别。

qinhuan66

hwc2ycy 发表于 2013-6-16 08:42
K列数据不够用的时候，就不会再生成了。
没有精确到行，只精确组别。

好的。真的谢谢您。