Sub SplitTableByManufacturer()

Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long, j As Long
Dim dict As Object
Dim manufacturer As String
Dim newWs As Worksheet
Dim startRow As Long

'获取当前活动表格
Set ws = ActiveSheet

'获取最后一行
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

'创建字典存储生产厂家及其对应的表格
Set dict = CreateObject("Scripting.Dictionary")

'遍历表格
For i = 2 To lastRow
    '获取生产厂家
    manufacturer = ws.Cells(i, 3).Value
    
    '如果字典中没有该生产厂家,则创建新表格
    If Not dict.exists(manufacturer) Then
        Set newWs = Worksheets.Add(After:=Worksheets(Worksheets.Count))
        newWs.Name = manufacturer
        newWs.Cells(1, 1).Value = "生产日期"
        newWs.Cells(1, 2).Value = "产品名称"
        newWs.Cells(1, 3).Value = "生产厂家"
        startRow = 2
        dict.Add manufacturer, newWs
    '如果字典中已经有该生产厂家,则直接获取对应的表格
    Else
        Set newWs = dict(manufacturer)
        startRow = newWs.Cells(newWs.Rows.Count, "A").End(xlUp).Row + 1
    End If
    
    '将当前行的数据复制到新表格中
    For j = 1 To 3
        newWs.Cells(startRow, j).Value = ws.Cells(i, j).Value
    Next j
Next i

'删除原始表格
ws.Delete

End Su

写一段VBA将表格按照生产厂家拆分为多个表

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

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