VBA 拆分从第三行开始拆分，怎么改编码

Question

Sub 保留表头拆分数据为若干新工作簿()

c = Application.InputBox("请输入拆分列号", , 4, , , , , 1)
If c = 0 Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
arr = [a1].CurrentRegion
lc = UBound(arr, 2)
Set rng = [a1].Resize(, lc)
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(arr)
    If Not d.Exists(arr(i, c)) Then
        Set d(arr(i, c)) = Cells(i, 1).Resize(1, lc)
    Else
        Set d(arr(i, c)) = Union(d(arr(i, c)), Cells(i, 1).Resize(1, lc))
    End If
Next
k = d.Keys
t = d.Items
For i = 0 To d.Count - 2
    With Workbooks.Add(xlWBATWorksheet)
        rng.Copy .Sheets(1).[a1]
        t(i).Copy .Sheets(1).[a2]
        .SaveAs Filename:=ThisWorkbook.Path & "\" & k(i) & ".xls"
        .Close
    End With
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "完毕"

End Sub

Answer 1

引自免费微信小程序：皆我百晓生

在您提供的VBA宏中，它实现了根据用户指定的列号（默认为第4列）将数据拆分为多个独立的工作簿。这个宏首先获取当前活动工作表中的数据范围，并创建一个字典用于存储不同值及其对应的单元格区域。然后，它遍历数据并根据指定列的值更新字典。最后，它为每个唯一值创建一个新的工作簿，复制数据并保存。

如果您想要从第三行开始拆分数据，只需要对循环的起始位置进行调整。您可以将For i = 2 To UBound(arr)更改为For i = 3 To UBound(arr)，这样就从第三行开始处理数据了。

下面是修改后的代码：

Sub 保留表头拆分数据为若干新工作簿()
    c = Application.InputBox("请输入拆分列号", , 4, , , , , 1)
    If c = 0 Then Exit Sub
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    arr = [a1].CurrentRegion
    lc = UBound(arr, 2)
    Set rng = [a1].Resize(, lc)
    Set d = CreateObject("scripting.dictionary")
    For i = 3 To UBound(arr) ' 修改此处，从第三行开始
        If Not d.Exists(arr(i, c)) Then
            Set d(arr(i, c)) = Cells(i, 1).Resize(1, lc)
        Else
            Set d(arr(i, c)) = Union(d(arr(i, c)), Cells(i, 1).Resize(1, lc))
        End If
    Next
    k = d.Keys
    t = d.Items
    For i = 0 To d.Count - 2
        With Workbooks.Add(xlWBATWorksheet)
            rng.Copy .Sheets(1).[a1]
            t(i).Copy .Sheets(1].[a2]
            .SaveAs Filename:=ThisWorkbook.Path & "\" & k(i) & ".xls"
            .Close
        End With
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "完毕"
End Sub

现在，这个宏将会从第三行开始拆分数据。只需运行此宏，然后按照提示输入要拆分的列号即可。