怎么根据班级人数，在最后一名学生后面插入空白行

sunshuangzhong

chxw68 发表于 2024-12-24 09:13
修改好了。

’每天学习下褚老师的经典代码！
Sub test()
'如果班级人数不是8的倍数，则在该班尾插入相应空行。by chxw68
'有实际用途，写个备注，利于以后理解。
    Dim r%, i%, m%, xm%
    Dim arr, brr, zrr()
    Dim rng As Range
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
'以下代码为用union方法删除序号（第一列）为空的行
'----------------------------------------
    With Worksheets("数据")
        .AutoFilterMode = False
        r = .Cells(.Rows.Count, 1).End(xlUp).Row
        arr = .Range("a1:f" & r)
        Set rng = .Rows(r + 1)
        For i = 1 To UBound(arr)
            If Len(arr(i, 1)) = 0 Then
                Set rng = Union(rng, .Rows(i))
            End If
        Next
        rng.Delete
'______________________________________________
   
'以下代码为在不同班级下插入相应空行
'思路：循环班级，获取每个班级的起止号行，存入数组中。再对该数组从后往前循环，插入相应行数。
'条件是数据要先按班级排序
'----------------------------------------
        r = .Cells(.Rows.Count, 1).End(xlUp).Row
        arr = .Range("a1:f" & r)
        xm = 0
        m = 0
        For i = 2 To UBound(arr)
            If arr(i, 2) <> xm Then '例：第1个1<>0，则zrr(1)(0)=2，起始行号;zrr(1)(1)=2，班级最后一个行号;
                m = m + 1
                ReDim Preserve zrr(1 To m)
                zrr(m) = Array(i, i)
                xm = arr(i, 2)
            Else
                If m > 0 Then
                    zrr(m)(1) = i 'zrr(1)(1)=i，班级最后一个行号;
                End If
            End If
        Next
        For k = UBound(zrr) To 1 Step -1 '再对该数组从后往前循环，插入相应行数。
            rs = zrr(k)(1) - zrr(k)(0) + 1 '班级人数,终行-始行+1
            x = Application.Ceiling(rs, 8) - rs '取rs的8倍数的最大值-rs=应插入的行数
            If x > 0 Then
                .Rows(zrr(k)(1) + 1).Resize(x).Insert '插入行数
                .Cells(zrr(k)(1) + 1, 2).Resize(x, 1) = arr(zrr(k)(0), 2) '写入班级名称
            End If
        Next
    End With
    Application.ScreenUpdating = True
    MsgBox "数据处理完毕！"
End Sub