Question

我正在学习VBA，我有在网上找到的这段代码，非常适合分割数据表。问题是，我现在正在拆分一个新程序，每张纸上必须有三个标题行。

谢谢！

Sub SplitDataNrows()

Dim N As Long, H As Long, rw As Long, lr As Long, Titles As Boolean

If MsgBox("Split the activesheet into smaller sheets?", vbYesNo, _
            "Confirm") = vbNo Then Exit Sub
N = Application.InputBox("How many rows per sheet?", "N-Rows", 50, Type:=1)
    If N = 0 Then Exit Sub
If MsgBox("Include the title row1 on each new sheet?", vbYesNo, _
            "Titles?") = vbYes Then Titles = True

Application.ScreenUpdating = False
With ActiveSheet
    lr = .Range("A" & .Rows.Count).End(xlUp).Row

    For rw = 1 + ---Titles To lr Step N
        Sheets.Add
        If Titles Then
            .Rows(1).Copy Range("A1")
            .Range("A" & rw).Resize(N).EntireRow.Copy Range("A2")
        Else
            .Range("A" & rw).Resize(N).EntireRow.Copy Range("A1")
        End If
        Columns.AutoFit
    Next rw

    .Activate
End With
Application.ScreenUpdating = True

End Sub

我该如何修改它，以便它询问我有多少个标题行，然后在每个新表上放置该行数？

Answer 1

您可以将Titles更改为Long数据类型，然后再次使用InputBox来允许用户输入数字。

Sub SplitDataNrows()

Dim N As Long, H As Long, rw As Long, lr As Long, Titles As Long

If MsgBox("Split the activesheet into smaller sheets?", vbYesNo, _
            "Confirm") = vbNo Then Exit Sub
N = Application.InputBox("How many rows per sheet?", "N-Rows", 50, Type:=1)
    If N = 0 Then Exit Sub
Titles = InputBox("How many title rows?", "Title Rows",1)

Application.ScreenUpdating = False
With ActiveSheet
    lr = .Range("A" & .Rows.Count).End(xlUp).Row

    For rw = 1 + Titles To lr Step N
        Sheets.Add
        If Titles > 0 Then
            .Range("A1:A" & Titles).EntireRow.Copy Range("A1")
            .Range("A" & rw).Resize(N).EntireRow.Copy Range("A" & 1 + Titles)
        Else
            .Range("A" & rw).Resize(N).EntireRow.Copy Range("A1")
        End If
        Columns.AutoFit
    Next rw

    .Activate
End With
Application.ScreenUpdating = True

End Sub

您还可以考虑添加错误处理程序，以解决用户的非数字条目。

如何将数据拆分为多个表（例如3个标题行）？

1 个答案: