求助：为什么D列没有试室号生成时出错,

qinhuan66

求助：为什么D列没有试室号生成时出错,谢谢
求助为什么为有试室号生成时时出错.rar (34.83 KB, 下载次数: 10)

2013-6-17 16:56 上传

点击文件名下载附件

hwc2ycy

arr(arr0(i, 4) * 17 - 16, 2) = "考场地址：“

D列无数据时，这数据成负数了，你的数组可不是从负数开始的嘛。

hwc2ycy

hwc2ycy

你这代码应用得不错了，从医院到教育系统。

qinhuan66

hwc2ycy 发表于 2013-6-17 19:15

谢谢您老师换成这样可以了
Private Sub CommandButton1_Click()With Sheets("座位安排表") '自己加进去解除密码
.Unprotect ("695360052") '自己加进去解除密码
Range("A3:S2000").ClearContents '先删除A列3至2000的单元格数据
Dim i As Integer, j As Integer, RoomNo As Integer, RowsInRoom As Integer, PeopleInRoom As Integer, arr0, arr
arr0 = Sheets("数据库").UsedRange
ReDim arr(1 To UBound(arr0), 1 To 19)
For i = 3 To UBound(arr0)
If arr0(i, 1) <> "" Then
    PeopleInRoom = Application.WorksheetFunction.CountIf(Sheets("数据库").Range("D3:D65535"), arr0(i, 4))
    RowsInRoom = IIf(PeopleInRoom Mod 5, PeopleInRoom \ 5 + 1, PeopleInRoom \ 5)
    If IsNumeric(arr0(i, 4)) And arr0(i, 4) > 0 Then
    arr(arr0(i, 4) * 17 - 16, 2) = "考场地址："
    arr(arr0(i, 4) * 17 - 16, 4) = arr0(i, 10)
    arr(arr0(i, 4) * 17 - 16, 14) = "试室号："
    arr(arr0(i, 4) * 17 - 16, 16) = "第" & Replace(Application.WorksheetFunction.Text(arr0(i, 4), "[DBNum1][$-804]General"), "一十", "十") & "试室"
    arr(arr0(i, 4) * 17 - 14, 9) = "讲  台"
    Else
    MsgBox "试室号填写不全": Exit Sub
    End If
    For j = 1 To PeopleInRoom
        arr((arr0(i, 4) - 1) * 17 + IIf(((j - 1) \ RowsInRoom) Mod 2, RowsInRoom * 2 + 3 - ((j - 1) Mod RowsInRoom) * 2, ((j - 1) Mod RowsInRoom) * 2 + 5), _
            ((j - 1) \ RowsInRoom) * 4 + 3) = Format(j, "00")
        arr((arr0(i, 4) - 1) * 17 + IIf(((j - 1) \ RowsInRoom) Mod 2, RowsInRoom * 2 + 3 - ((j - 1) Mod RowsInRoom) * 2, ((j - 1) Mod RowsInRoom) * 2 + 5), _
            ((j - 1) \ RowsInRoom) * 4 + 2) = arr0(i + j - 1, 6)
        arr((arr0(i, 4) - 1) * 17 + IIf(((j - 1) \ RowsInRoom) Mod 2, RowsInRoom * 2 + 3 - ((j - 1) Mod RowsInRoom) * 2, ((j - 1) Mod RowsInRoom) * 2 + 5), _
            ((j - 1) \ RowsInRoom) * 4 + 1) = "准考证号"
        arr((arr0(i, 4) - 1) * 17 + IIf(((j - 1) \ RowsInRoom) Mod 2, RowsInRoom * 2 + 4 - ((j - 1) Mod RowsInRoom) * 2, ((j - 1) Mod RowsInRoom) * 2 + 6), _
            ((j - 1) \ RowsInRoom) * 4 + 2) = arr0(i + j - 1, 1)
        arr((arr0(i, 4) - 1) * 17 + IIf(((j - 1) \ RowsInRoom) Mod 2, RowsInRoom * 2 + 4 - ((j - 1) Mod RowsInRoom) * 2, ((j - 1) Mod RowsInRoom) * 2 + 6), _
            ((j - 1) \ RowsInRoom) * 4 + 1) = "姓名"
    Next j
    i = i + Application.WorksheetFunction.CountIf(Sheets("数据库").Range("D3:D1000"), arr0(i, 4)) - 1
End If
Next i
Sheets("座位安排表").Range("A1").Resize(UBound(arr, 1), 19) = arr
.Protect ("695360052") '自己加进去上锁密码
    End With '自己加进去上锁密码
End Sub