以下是一个示例代码,可以按照指定的字段将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

说明:

  1. 将上述代码复制到Excel的VBA编辑器中(按Alt+F11进入)。
  2. 打开需要分割的Excel文件。
  3. 在VBA编辑器中按F5运行代码。
  4. 程序将按照第1列的值将Excel文件分割成多个文件,每个文件的文件名格式为SplitFile_XXX.xlsx,其中XXX为第1列的值。
  5. 分割后的文件保存在原文件所在的文件夹中。原文件将关闭
编写VB代码对打开的excel文件按字段分成多个excel文件

原文地址: https://www.cveoy.top/t/topic/cfs1 著作权归作者所有。请勿转载和采集!

免费AI点我,无需注册和登录