编写VB代码对打开的excel文件按字段分成多个excel文件
以下是一个示例代码,可以按照指定的字段将Excel文件分成多个文件:
Sub SplitExcelFile()
Dim wb As Workbook
Dim ws As Worksheet
Dim newWb As Workbook
Dim newWs As Worksheet
Dim lastRow As Long
Dim i As Long
Dim j As Long
Dim fieldIndex As Long
Dim fieldValue As String
Dim fileName As String
'设置要分割的字段的索引和文件名格式
fieldIndex = 1 '第1列为分割字段
fileName = "SplitFile_{0}.xlsx" '文件名格式
Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row '获取最后一行
'按照分割字段逐行处理
For i = 2 To lastRow
fieldValue = CStr(ws.Cells(i, fieldIndex).Value) '获取分割字段的值
'如果分割字段的值改变或是处理到最后一行,就新建一个文件
If fieldValue <> CStr(ws.Cells(i - 1, fieldIndex).Value) Or i = lastRow Then
'保存之前的文件
If Not newWb Is Nothing Then
newWb.Save
newWb.Close
End If
'新建一个文件
Set newWb = Workbooks.Add
Set newWs = newWb.ActiveSheet
'复制表头
For j = 1 To ws.Columns.Count
newWs.Cells(1, j).Value = ws.Cells(1, j).Value
Next
'复制符合条件的行
Dim newRow As Long
newRow = 2
For j = i - 1 To 2 Step -1
If CStr(ws.Cells(j, fieldIndex).Value) = fieldValue Then
ws.Rows(j).Copy newWs.Rows(newRow)
newRow = newRow + 1
Else
Exit For
End If
Next
'设置文件名
newWb.SaveAs Replace(fileName, "{0}", fieldValue)
End If
Next
'关闭文件
wb.Close
End Sub
说明:
- 将上述代码复制到Excel的VBA编辑器中(按Alt+F11进入)。
- 打开需要分割的Excel文件。
- 在VBA编辑器中按F5运行代码。
- 程序将按照第1列的值将Excel文件分割成多个文件,每个文件的文件名格式为SplitFile_XXX.xlsx,其中XXX为第1列的值。
- 分割后的文件保存在原文件所在的文件夹中。原文件将关闭
原文地址: https://www.cveoy.top/t/topic/cfs1 著作权归作者所有。请勿转载和采集!