使用Excel的宏来实现将每10行数据创建为一个新表的功能。以下是一个示例的VBA代码：
Sub 分割数据()
Dim 原始表 As Worksheet
Dim 新表 As Worksheet
Dim 数据区域 As Range
Dim 行数 As Integer
Dim 总行数 As Integer
Dim 表号 As Integer
行数 = 10 '定义每个新表的行数
'设置原始表和数据区域
Set 原始表 = ThisWorkbook.Worksheets("Sheet1") '将"Sheet1"替换为你的原始表名称
Set 数据区域 = 原始表.Range("A1").CurrentRegion
'计算总行数并判断是否需要创建新表
总行数 = 数据区域.Rows.Count
If 总行数 <= 行数 Then Exit Sub '数据行数不足一个新表所需的行数时，退出
Application.ScreenUpdating = False '关闭屏幕更新以提高处理速度
'循环创建新表
For 表号 = 1 To Int(总行数 / 行数) + 1
'在当前工作簿中创建新表
With ThisWorkbook
Set 新表 = .Worksheets.Add(After:=.Sheets(.Sheets.Count))
End With
'将数据复制到新表
数据区域.Copy 新表.Range("A1")
'删除多余的行
If 表号 < Int(总行数 / 行数) + 1 Then
新表.Rows(行数 + 1 & ":" & 新表.Rows.Count).Delete
End If
Next 表号
Application.ScreenUpdating = True '重新打开屏幕更新
MsgBox "数据已成功分割为" & Int(总行数 / 行数) + 1 & "个表。"
End Sub请按照以下步骤操作（Sheet）：
- 打开Excel，按下
ALT + F11打开VBA编辑器。 - 在左侧的“项目资源管理器”窗格中，找到你的工作簿，并双击打开。
- 在VBA编辑器的窗口中，插入新模块（
Insert -> Module）。 - 将上述代码复制粘贴到新模块中。
- 关闭VBA编辑器。
- 返回Excel界面，在菜单栏中点击“开发者”选项卡，如果没有该选项卡，请在Excel选项中启用“开发者”选项卡。
- 在“开发者”选项卡中找到“宏”按钮。
- 点击“宏”按钮，在弹出的对话框中选择“分割数据”，然后点击“运行”。
这样，每10行数据将会被创建为一个新的表格，并且你将得到一个弹出窗口，显示成功分割为多少个表格。注意替换代码中的表格名称和每个新表格的行数，以适应你的实际情况。
如果每10行数据创建一个新的工作簿而不是新的工作表（Sheet），可以使用以下VBA代码：
Sub 分割数据()
Dim 原始表 As Worksheet
Dim 新表 As Workbook
Dim 数据区域 As Range
Dim 行数 As Integer
Dim 总行数 As Integer
Dim 表号 As Integer
行数 = 10 '定义每个新表的行数
'设置原始表和数据区域
Set 原始表 = ThisWorkbook.Worksheets("Sheet1") '将"Sheet1"替换为你的原始表名称
Set 数据区域 = 原始表.Range("A1").CurrentRegion
'计算总行数并判断是否需要创建新表
总行数 = 数据区域.Rows.Count
If 总行数 <= 行数 Then Exit Sub '数据行数不足一个新表所需的行数时，退出
Application.ScreenUpdating = False '关闭屏幕更新以提高处理速度
'循环创建新表
For 表号 = 1 To Int(总行数 / 行数) + 1
'创建新工作簿
Set 新表 = Workbooks.Add
'将数据复制到新工作簿
数据区域.Copy 新表.Worksheets(1).Range("A1")
'删除多余的行
If 表号 < Int(总行数 / 行数) + 1 Then
新表.Worksheets(1).Rows(行数 + 1 & ":" & 新表.Worksheets(1).Rows.Count).Delete
End If
'保存新工作簿
新表.SaveAs ThisWorkbook.Path & "\新表" & 表号 & ".xlsx" '根据需要修改保存路径和文件名
'关闭新工作簿
新表.Close SaveChanges:=False
Next 表号
Application.ScreenUpdating = True '重新打开屏幕更新
MsgBox "数据已成功分割为" & Int(总行数 / 行数) + 1 & "个新表。"
End Sub请注意，此代码将创建新的工作簿，并在每个新工作簿中复制相应的数据。你可以根据需求修改代码中的保存路径和文件名。运行代码后，将显示一个弹出窗口，指示成功分割为多少个新表。
如果需要更改行数或其他相关参数，只需修改代码中相应的行数即可。
修改代码中的数据区域，可以将其更改为你想要分割的数据所在的范围。以下是几种常用的方法：
- 使用具体的范围地址：你可以将
数据区域定义为特定的范围地址，例如"A1:D100"。 - 使用Cells函数：你可以使用
Cells函数指定数据区域的起始单元格和结束单元格，例如Set 数据区域 = 原始表.Range(Cells(1, 1), Cells(100, 4))表示数据从第1行第1列开始，到第100行第4列结束。 - 使用Named Range：如果你已经为数据区域设置了命名范围，可以直接使用命名范围代替具体的范围地址，例如
Set 数据区域 = 原始表.Range("DataRange")，其中"DataRange"是你为数据区域设置的命名范围名称。
请根据你的实际需求选择适合的方法，并将代码中的数据区域相应地进行修改。
如果想将原始数据分割为多个表格，每个表格包含连续的10行数据，并且每个数据只包含在一个表格中，以下是一个示例的 VBA 代码来实现这个功能（不带标题行）：
Sub 分割数据()
Dim 原始表 As Worksheet
Dim 新表 As Workbook
Dim 数据区域 As Range
Dim 总行数 As Integer
Dim 表号 As Integer
Dim 起始行 As Integer
Dim 结束行 As Integer
Dim 行数 As Integer
行数 = 10 ' 定义每个新表的行数
' 设置原始表和数据区域
Set 原始表 = ThisWorkbook.Worksheets("Sheet1") ' 将 "Sheet1" 替换为你的原始表名称
Set 数据区域 = 原始表.Range("A1").CurrentRegion
' 计算总行数并判断是否需要创建新表
总行数 = 数据区域.Rows.Count
If 总行数 <= 行数 Then Exit Sub ' 数据行数不足一个新表所需的行数时，退出
Application.ScreenUpdating = False ' 关闭屏幕更新以提高处理速度
' 循环创建新表
For 表号 = 1 To Int(总行数 / 行数) + 1
' 创建新工作簿
Set 新表 = Workbooks.Add
' 设置新表的起始行和结束行
起始行 = (表号 - 1) * 行数 + 1
结束行 = WorksheetFunction.Min(总行数, 表号 * 行数)
' 将数据复制到新工作簿
数据区域.Rows(起始行 & ":" & 结束行).Copy 新表.Worksheets(1).Range("A1")
' 保存新工作簿
新表.SaveAs ThisWorkbook.Path & "\新表" & 表号 & ".xlsx" ' 根据需要修改保存路径和文件名
' 关闭新工作簿
新表.Close SaveChanges:=False
Next 表号
Application.ScreenUpdating = True ' 重新打开屏幕更新
MsgBox "数据已成功分割为" & Int(总行数 / 行数) + 1 & "个新表。"
End Sub这段代码将会根据每个新表的起始行和结束行，将原始数据的对应部分复制到新表中，保证每个数据只出现在一个表格中，同时每个新表包含连续的10行数据。
请注意，在代码中，我假设原始数据从第一行开始，且每个新表都保存为单独的Excel文件。你可以根据实际需求进行修改。
如果你想在每个新表中包含标题行并分割数据，可以使用以下修订版的 VBA 代码：
Sub 分割数据()
Dim 原始表 As Worksheet
Dim 新表 As Workbook
Dim 数据区域 As Range
Dim 总行数 As Integer
Dim 表号 As Integer
Dim 起始行 As Integer
Dim 结束行 As Integer
Dim 行数 As Integer
行数 = 10 ' 定义每个新表的行数
' 设置原始表和数据区域
Set 原始表 = ThisWorkbook.Worksheets("Sheet1") ' 将 "Sheet1" 替换为你的原始表名称
Set 数据区域 = 原始表.Range("A1").CurrentRegion
' 计算总行数并判断是否需要创建新表
总行数 = 数据区域.Rows.Count
If 总行数 <= 行数 Then Exit Sub ' 数据行数不足一个新表所需的行数时，退出
Application.ScreenUpdating = False ' 关闭屏幕更新以提高处理速度
' 循环创建新表
For 表号 = 1 To Int(总行数 / 行数) + 1
' 创建新工作簿
Set 新表 = Workbooks.Add
With 新表.Worksheets(1)
' 设置新表的起始行和结束行
起始行 = (表号 - 1) * 行数 + 1
结束行 = WorksheetFunction.Min(总行数, 表号 * 行数)
' 将标题行复制到新工作簿
数据区域.Rows(1).Copy .Range("A1")
' 将数据复制到新工作簿
数据区域.Rows(起始行 & ":" & 结束行).Copy .Range("A2")
End With
' 保存新工作簿
新表.SaveAs ThisWorkbook.Path & "\新表" & 表号 & ".xlsx" ' 根据需要修改保存路径和文件名
' 关闭新工作簿
新表.Close SaveChanges:=False
Next 表号
Application.ScreenUpdating = True ' 重新打开屏幕更新
MsgBox "数据已成功分割为" & Int(总行数 / 行数) + 1 & "个新表，并且包含标题行。"
End Sub这段代码在每个新表中通过将标题行和对应的数据行复制到新工作簿来实现分割。新工作簿中的第一行是标题行，接下来的行是对应的数据行。
请注意，这段代码也假设原始数据从第一行开始，并且每个新表保存为单独的Excel文件。你可以根据实际需求进行修改。
学术教材 本站采用 CC BY-NC-SA 4.0 授权协议，转载请注明来源，谢谢！