【快递】 2026/6/8 13:51:24
正文： 说说你对工具箱的看法Sub 拆分()
Dim wsSrc As Worksheet
Dim wsDest As Worksheet
Dim colQuantity As Long
Dim lastRow As Long
Dim lastCol As Long
Dim i As Long
Dim packageSize As Integer
Dim destRow As Long
Dim colorToggle As Boolean
Dim originalValue As Variant
Dim quantity As Integer
Dim remaining As Integer
Dim currentPackage As Integer
Dim userInput As String
Dim j As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set wsSrc = ActiveSheet
' 查找数量列
lastRow = wsSrc.Cells(wsSrc.Rows.Count, 1).End(xlUp).Row
lastCol = wsSrc.Cells(1, wsSrc.Columns.Count).End(xlToLeft).Column
colQuantity = 0
For j = 1 To lastCol
If wsSrc.Cells(1, j).Value = "数量" Or wsSrc.Cells(1, j).Value = "商品数量" Then
colQuantity = j
Exit For
End If
Next j
If colQuantity = 0 Then
MsgBox "未找到【数量】或【商品数量】标题行", vbCritical
GoTo CleanUp
End If
' 弹窗输入每个包裹的数量
userInput = InputBox("请输入每个包裹的数量（整数）：" & vbCrLf & _
"例如：2 表示每个包裹2件，余数单独一个包裹" & vbCrLf & _
"例如：1 表示单件拆分", _
"包裹数量设置", "2")
If userInput = "" Then GoTo CleanUp
If Not IsNumeric(userInput) Or Val(userInput) < 1 Then
MsgBox "请输入正整数", vbCritical
GoTo CleanUp
End If
packageSize = CInt(userInput)
' 创建新工作表
Set wsDest = Sheets.Add(After:=wsSrc)
wsDest.Name = "拆分结果_" & Format(Now, "HHMMSS")
' 复制标题行
wsSrc.Rows(1).Copy Destination:=wsDest.Rows(1)
destRow = 2
colorToggle = True ' True=淡黄色, False=淡紫色
' 遍历数据行
For i = 2 To lastRow
originalValue = wsSrc.Cells(i, colQuantity).Value
If Not IsNumeric(originalValue) Or originalValue <= 0 Then
If originalValue <> "" Then MsgBox "第" & i & "行数量无效，已跳过"
GoTo NextRow
End If
quantity = CInt(originalValue)
remaining = quantity
' 按固定包裹数量拆分
Do While remaining > 0
If remaining >= packageSize Then
currentPackage = packageSize
Else
currentPackage = remaining
End If
remaining = remaining - currentPackage
' 复制并写入数据
wsSrc.Rows(i).Copy Destination:=wsDest.Rows(destRow)
wsDest.Cells(destRow, colQuantity).Value = currentPackage
' 填充颜色（只填充有内容的单元格）
If colorToggle Then
' 淡黄色 RGB(255, 240, 160)
wsDest.Rows(destRow).Cells.SpecialCells(xlCellTypeConstants).Interior.Color = RGB(255, 240, 160)
Else
' 淡紫色 RGB(210, 190, 240)
wsDest.Rows(destRow).Cells.SpecialCells(xlCellTypeConstants).Interior.Color = RGB(210, 190, 240)
End If
destRow = destRow + 1
Loop
' 两种颜色交替
colorToggle = Not colorToggle
NextRow:
Next i
' 格式化
wsDest.Columns.AutoFit
wsDest.Rows.AutoFit
wsDest.Cells.HorizontalAlignment = xlLeft
wsDest.Activate
MsgBox "拆分完成！共生成 " & (destRow - 2) & " 行数据", vbInformation
CleanUp:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub，
【汽车】 2026/6/5 10:39:04
正文： 希望 批量打印功能 能支持PDF文件,用处挺多的， 打印学员档案，每个学员1个PDF文件，结业证书也是，学时证明， 一次就是300个PDF 需要打印，
【建筑】 2026/6/1 17:05:07
正文： 软件有一个致命缺陷。具体表现在打印方面。比如我一个EXCEL工作簿有100个sheet工作表。每个工作表中有纵向排列10个表格。我要选定这100个SHEET表格中第三个统一表格打印，且要求是单面打印，结果是原来软件无法单面打印，方方格子也无法做到单面打印，要手动一个一个改为单面打印才行，希望工作室能解决此问题。
