如何实现自动分栏形成以下效果

bcly

在网上看到一遍文章，将数据进行自动分栏，感觉挺好，也实现了自动分栏，但班与班学生数据不能区分开，如何实现以下图中效果分栏的同时将班与班学生之间进行分页



Sub 自动分栏()
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Set sh1 = Sheets("原数据")
    Set sh2 = Sheets("分栏数据")
    ar = sh1.Range("a1").CurrentRegion
    p = sh2.[h1] '每页行数
    h = sh2.[j1] '行高
    j = 1 '记录行数
    ActiveSheet.ResetAllPageBreaks '重置分页符
    sh2.Range("a2:f65535").ClearContents '清空数据
    For i = 2 To UBound(ar)
        If j > p * 2 Then '判断第二栏是否结束
            j = 1 '初始化行数
        End If
        If j = p Then '判断第一栏是否结束
            sh2.HPageBreaks.Add Before:=Range("A" & r + 2) '设置分页符
            sh2.Rows("2:" & r + 1).RowHeight = h '设置行高
        End If
        If j <= p Then '判断页行数是否大于指定行数
            c = 1 '第一栏A列开始
        Else
            c = 1 + UBound(ar, 2) '第二栏开始位置
        End If
        r = sh2.Cells(65535, c).End(3).Row + 1 '获取最后一行的下一行
        For k = 1 To UBound(ar, 2)
           sh2.Cells(r, c + k - 1) = ar(i, k) '写入数据
        Next
        j = j + 1 '行数累加
    Next
    MsgBox "分栏完成！"
End Sub

hxj119

建议用VBA更加合适解决此类问题。