链接: https://pan.baidu.com/s/1LZUfBoSUZzbiCDJZRQ2VWg?pwd=52pj 提取码: 52pj
这是客户拿来打印的工资表格，她是想每个姓名下面的工序不能分行，而且不能一页一个名字工序这样浪费纸，我前面弄的代码如下：Sub CompletePageBreaksWithHeaders()
Dim ws As Worksheet
Dim lastRow As Long, i As Long, startRow As Long
Dim personCount As Integer, rowCount As Integer
Dim personRows As Collection
Dim maxRowsPerPage As Integer
' 设置工作表
Set ws = ActiveSheet
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
' 第一步：删除重复的标题行（保留第3行的标题）
Dim headerRowsDeleted As Integer
headerRowsDeleted = 0
' 从最后一行向上遍历，避免删除时行号变化
For i = lastRow To 4 Step -1
If ws.Cells(i, 1).Value = "姓名/日期" And i > 3 Then
ws.Rows(i).Delete
headerRowsDeleted = headerRowsDeleted + 1
End If
Next i
' 更新最后一行
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' 第二步：删除所有现有的分页符
ws.ResetAllPageBreaks
' 第三步：设置打印标题（表头）- 这是关键步骤，确保每页都有表头
With ws.PageSetup
.PrintTitleRows = "$3:$3" ' 设置第3行为每页重复的标题行
End With
' 第四步：找出每个人的起始行和行数
Set personRows = New Collection
startRow = 0
For i = 4 To lastRow
' 检查A列是否包含"姓名/日期"格式的内容
If InStr(ws.Cells(i, 1).Value, "/") > 0 Then
If startRow > 0 Then
' 添加上一个人的行数信息
personRows.Add Array(startRow, i - startRow)
End If
startRow = i
End If
Next i
' 添加最后一个人的行数信息
If startRow > 0 Then
personRows.Add Array(startRow, lastRow - startRow + 1)
End If
' 第五步：智能添加分页符
Dim currentPageRows As Integer
currentPageRows = 0
maxRowsPerPage = 40 ' 每页最大行数（可根据需要调整）
For i = 1 To personRows.Count
Dim personInfo As Variant
personInfo = personRows(i)
Dim personStartRow As Integer
Dim personRowCount As Integer
personStartRow = personInfo(0)
personRowCount = personInfo(1)
' 如果当前页已满或这是第一个人员，则添加分页符
If currentPageRows + personRowCount > maxRowsPerPage And currentPageRows > 0 Then
ws.HPageBreaks.Add Before:=ws.Rows(personStartRow)
currentPageRows = personRowCount
Else
currentPageRows = currentPageRows + personRowCount
End If
Next i
' 第六步：设置打印区域
ws.PageSetup.PrintArea = ws.Range("A1:F" & lastRow).Address
' 第七步：设置页面为A4纵向
With ws.PageSetup
.Orientation = xlPortrait
.PaperSize = xlPaperA4
.FitToPagesWide = 1
.FitToPagesTall = False
End With
Application.ScreenUpdating = True
' 第八步：手动验证打印标题设置（确保Excel正确应用设置）
' 有时需要手动触发一次才能确保设置生效
ws.PageSetup.PrintTitleRows = ws.PageSetup.PrintTitleRows
MsgBox "操作完成！" & vbCrLf & _
"已删除 " & headerRowsDeleted & " 个重复标题行" & vbCrLf & _
"已为 " & personRows.Count & " 个人员记录优化分页" & vbCrLf & _
"每页顶部都会显示表头"
End Sub
问题就是最后一个孙梅艳会只打印一行打不完整。我想到的办法是在末尾复制孙梅艳这一行。有没有人能用代码弄好
