[已解决]谁能注释下这个vba ， 我看不懂，谢谢！

fanyixiao123

谁能注释下这个vba ， 我看不懂，谢谢！


Sub 生成考场信息()
    Dim Row1
    Dim Arr1, Arr11()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    With Sheets("考生信息")
        Row1 = .Range("B" & .Rows.Count).End(xlUp).Row
        Arr1 = .Range("B2:C" & Row1)
    End With
    With Sheets("考场信息")
        Row2 = .Range("B" & .Rows.Count).End(xlUp).Row
        ARR2 = .Range("B2:B" & Row1)
    End With
    For Each sht In Sheets
        If sht.Name Like "试场*" Then
            sht.Delete
        End If
    Next
    For I = 1 To UBound(Arr1) Step 30
        ReDim Arr11(1 To 8, 1 To 12)
        S1 = I
        S2 = IIf(I + 30 > UBound(Arr1), UBound(Arr1), I + 29)
        N = N + 1
        For J = 1 To 7
            If J + I - 1 > UBound(Arr1) Then Exit For
            Arr11(J, 1) = Arr1(I + J - 1, 1)
            Arr11(J, 2) = Arr1(I + J - 1, 2)
            Arr11(J, 3) = J
        Next J
        For J = 8 To 14
            If J + I - 1 > UBound(Arr1) Then Exit For
            Arr11(15 - J, 4) = Arr1(I + J - 1, 1)
            Arr11(15 - J, 5) = Arr1(I + J - 1, 2)
            Arr11(15 - J, 6) = J
        Next J
        For J = 15 To 22
            If J + I - 1 > UBound(Arr1) Then Exit For
            Arr11(J - 14, 7) = Arr1(I + J - 1, 1)
            Arr11(J - 14, 8) = Arr1(I + J - 1, 2)
            Arr11(J - 14, 9) = J
        Next J
        For J = 23 To 30
            If J + I - 1 > UBound(Arr1) Then Exit For
            Arr11(31 - J, 10) = Arr1(I + J - 1, 1)
            Arr11(31 - J, 11) = Arr1(I + J - 1, 2)
            Arr11(31 - J, 12) = J
        Next J
        Sheets("样表").Copy After:=Sheets(Sheets.Count)
        With Sheets(Sheets.Count)
            .Name = "试场" & N
            .[F1] = N
            .[F2] = ARR2(N, 1)
            .[F3] = Arr1(S1, 1) & "--" & Arr1(S2, 1)
            .[A5].Resize(UBound(Arr11), UBound(Arr11, 2)) = Arr11
        End With
    Next I
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

最佳答案

月排行榜 / 总排行榜

zjdh

2014-11-15 08:36

Sub 生成考场信息()
    Dim Row1
    Dim Arr1, Arr11()
    Application.DisplayAlerts = False   '不提示
    Application.ScreenUpdating = False  '不刷屏
    With Sheets("考生信息")
        Row1 = .Range("B" & .Rows.Count).End(xlUp).Row   '考生信息的最后一行行号
        Arr1 = .Range("B2:C" & Row1)    '考生信息赋于数组
    End With
    With Sheets("考场信息")             '同上将考场信息赋于数组
        Row2 = .Range("B" & .Rows.Count).End(xlUp).Row
        ARR2 = .Range("B2:B" & Row2)
    End With
    For Each sht In Sheets            '扫描每一个工作表
        If sht.Name Like "试场*" Then '是考场工作表就删除
            sht.Delete
        End If
    Next
    For I = 1 To UBound(Arr1) Step 30   '数组循环，步距30
        ReDim Arr11(1 To 8, 1 To 12)    '重新定义数组
        S1 = I                          '起始序号
        S2 = IIf(I + 30 > UBound(Arr1), UBound(Arr1), I + 29)    '结束序号，若超出总序号则用总序号，否则用起始序号+29
        N = N + 1        '考场编号
        For J = 1 To 7   '前7位安排
            If J + I - 1 > UBound(Arr1) Then Exit For  '若超出总序号则退出循环
            Arr11(J, 1) = Arr1(I + J - 1, 1)       '赋值考号
            Arr11(J, 2) = Arr1(I + J - 1, 2)       '赋值姓名
            Arr11(J, 3) = J                        '赋值座号
        Next J
        For J = 8 To 14   '后7位安排，逆序
            If J + I - 1 > UBound(Arr1) Then Exit For   '以下原理同上
            Arr11(15 - J, 4) = Arr1(I + J - 1, 1)
            Arr11(15 - J, 5) = Arr1(I + J - 1, 2)
            Arr11(15 - J, 6) = J
        Next J
        For J = 15 To 22    '再后8位安排,顺序
            If J + I - 1 > UBound(Arr1) Then Exit For
            Arr11(J - 14, 7) = Arr1(I + J - 1, 1)
            Arr11(J - 14, 8) = Arr1(I + J - 1, 2)
            Arr11(J - 14, 9) = J
        Next J
        For J = 23 To 30   '最后8位安排，逆序
            If J + I - 1 > UBound(Arr1) Then Exit For
            Arr11(31 - J, 10) = Arr1(I + J - 1, 1)
            Arr11(31 - J, 11) = Arr1(I + J - 1, 2)
            Arr11(31 - J, 12) = J
        Next J
        Sheets("样表").Copy After:=Sheets(Sheets.Count)  '复制“样表”到最后
        With Sheets(Sheets.Count)    '针对最后一个工作表
            .Name = "试场" & N      '更名
            .[F1] = N              '考场编号
            .[F2] = ARR2(N, 1)     '考场名称
            .[F3] = Arr1(S1, 1) & "--" & Arr1(S2, 1)    '起止考号
            .[A5].Resize(UBound(Arr11), UBound(Arr11, 2)) = Arr11   '数组数值赋予工作表
        End With
    Next I
    Application.DisplayAlerts = True    '恢复提示
    Application.ScreenUpdating = True   '恢复刷屏
End Sub

跳转到最佳答案楼层

zjdh

Sub 生成考场信息()
    Dim Row1
    Dim Arr1, Arr11()
    Application.DisplayAlerts = False   '不提示
    Application.ScreenUpdating = False  '不刷屏
    With Sheets("考生信息")
        Row1 = .Range("B" & .Rows.Count).End(xlUp).Row   '考生信息的最后一行行号
        Arr1 = .Range("B2:C" & Row1)    '考生信息赋于数组
    End With
    With Sheets("考场信息")             '同上将考场信息赋于数组
        Row2 = .Range("B" & .Rows.Count).End(xlUp).Row
        ARR2 = .Range("B2:B" & Row2)
    End With
    For Each sht In Sheets            '扫描每一个工作表
        If sht.Name Like "试场*" Then '是考场工作表就删除
            sht.Delete
        End If
    Next
    For I = 1 To UBound(Arr1) Step 30   '数组循环，步距30
        ReDim Arr11(1 To 8, 1 To 12)    '重新定义数组
        S1 = I                          '起始序号
        S2 = IIf(I + 30 > UBound(Arr1), UBound(Arr1), I + 29)    '结束序号，若超出总序号则用总序号，否则用起始序号+29
        N = N + 1        '考场编号
        For J = 1 To 7   '前7位安排
            If J + I - 1 > UBound(Arr1) Then Exit For  '若超出总序号则退出循环
            Arr11(J, 1) = Arr1(I + J - 1, 1)       '赋值考号
            Arr11(J, 2) = Arr1(I + J - 1, 2)       '赋值姓名
            Arr11(J, 3) = J                        '赋值座号
        Next J
        For J = 8 To 14   '后7位安排，逆序
            If J + I - 1 > UBound(Arr1) Then Exit For   '以下原理同上
            Arr11(15 - J, 4) = Arr1(I + J - 1, 1)
            Arr11(15 - J, 5) = Arr1(I + J - 1, 2)
            Arr11(15 - J, 6) = J
        Next J
        For J = 15 To 22    '再后8位安排,顺序
            If J + I - 1 > UBound(Arr1) Then Exit For
            Arr11(J - 14, 7) = Arr1(I + J - 1, 1)
            Arr11(J - 14, 8) = Arr1(I + J - 1, 2)
            Arr11(J - 14, 9) = J
        Next J
        For J = 23 To 30   '最后8位安排，逆序
            If J + I - 1 > UBound(Arr1) Then Exit For
            Arr11(31 - J, 10) = Arr1(I + J - 1, 1)
            Arr11(31 - J, 11) = Arr1(I + J - 1, 2)
            Arr11(31 - J, 12) = J
        Next J
        Sheets("样表").Copy After:=Sheets(Sheets.Count)  '复制“样表”到最后
        With Sheets(Sheets.Count)    '针对最后一个工作表
            .Name = "试场" & N      '更名
            .[F1] = N              '考场编号
            .[F2] = ARR2(N, 1)     '考场名称
            .[F3] = Arr1(S1, 1) & "--" & Arr1(S2, 1)    '起止考号
            .[A5].Resize(UBound(Arr11), UBound(Arr11, 2)) = Arr11   '数组数值赋予工作表
        End With
    Next I
    Application.DisplayAlerts = True    '恢复提示
    Application.ScreenUpdating = True   '恢复刷屏
End Sub