写一段VBA将表格按照生产厂家拆分为多个表
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
原文地址: https://www.cveoy.top/t/topic/cjl2 著作权归作者所有。请勿转载和采集!