Excel工作表转PDF宏出现无限循环错误及多余表头PDF问题求助

你的宏遇到两个核心问题：无限循环停不下来和生成仅含表头的多余PDF，我来帮你拆解原因并给出修正方案：

问题根源分析 #

1. 无限循环：你定义UniqueRng的方式有问题——ws_unique.Range("A1:A20" & iLastRow_unique)会生成一个超大范围（比如iLastRow_unique=100时，范围变成A1:A20100），而且这个范围里包含大量空单元格，循环会一直遍历这些空值，导致无法终止。另外你没有真正提取唯一的员工ID，只是重复遍历原表的列A，会重复处理相同ID。
2. 多余表头PDF：循环包含了表头单元格（A1），当过滤A1的值时，只有表头行匹配，所以导出了仅含表头的PDF。

修正后的完整代码 #

Sub PracticeToPDF()
    Dim ws As Worksheet
    Dim tempWs As Worksheet
    Dim DataRange As Range
    Dim iLastRow As Long
    Dim uniqueLastRow As Long
    Dim Cell As Range
    Dim DirectoryLocation As String
    
    Application.ScreenUpdating = False
    ' 设置PDF保存目录，先检查工作簿是否已保存
    DirectoryLocation = ActiveWorkbook.Path
    If DirectoryLocation = "" Then
        MsgBox "请先保存工作簿到指定文件夹！", vbExclamation
        Application.ScreenUpdating = True
        Exit Sub
    End If
    
    Set ws = Worksheets("BootVSPayroll")
    iLastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
    
    ' 1. 创建临时工作表存储唯一员工ID（避免重复处理）
    On Error Resume Next
    Set tempWs = ThisWorkbook.Worksheets("TempUniqueIDs")
    If Err.Number <> 0 Then
        Set tempWs = ThisWorkbook.Worksheets.Add
        tempWs.Name = "TempUniqueIDs"
    End If
    On Error GoTo 0
    
    ' 复制列A数据（跳过表头）到临时表并去重
    ws.Range("A2:A" & iLastRow).Copy tempWs.Range("A1")
    tempWs.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
    uniqueLastRow = tempWs.Cells(Rows.Count, "A").End(xlUp).Row
    
    ' 2. 定义正确的数据范围（表头+所有数据行）
    Set DataRange = ws.Range("$A$1:$K$" & iLastRow)
    
    ' 3. 遍历唯一员工ID，导出PDF
    For Each Cell In tempWs.Range("A1:A" & uniqueLastRow)
        ' 跳过空单元格，防止意外
        If Cell.Value <> "" Then
            DataRange.AutoFilter Field:=1, Criteria1:=Cell.Value
            ' 检查是否有匹配的数据行，避免导出仅表头的PDF
            If ws.Cells(Rows.Count, "A").End(xlUp).Row > 1 Then
                Dim pdfName As String
                pdfName = DirectoryLocation & "\" & Cell.Value & " BOOT Report.pdf"
                ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfName, _
                    Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                    IgnorePrintAreas:=False, OpenAfterPublish:=False
            End If
        End If
    Next Cell
    
    ' 清理操作
    ws.AutoFilterMode = False ' 关闭筛选
    Application.DisplayAlerts = False
    tempWs.Delete ' 删除临时工作表
    Application.DisplayAlerts = True
    
    ' 恢复工作表保护和设置
    With ws
        .Protect UserInterfaceOnly:=True, _
            DrawingObjects:=False, Contents:=True, Scenarios:=True, _
            AllowFormattingColumns:=True, AllowFormattingRows:=True
        .EnableOutlining = True
        .EnableAutoFilter = True
    End With
    
    Application.ScreenUpdating = True
    MsgBox "PDF导出完成！", vbInformation
End Sub

关键修改说明 #

• 解决无限循环：
  • 创建临时工作表存储去重后的员工ID，只遍历真正有值的唯一ID，避免遍历空单元格和重复值。
  • 修正了DataRange的定义（原来的"$A$1:$K$1" & iLastRow是语法错误，改为"$A$1:$K$" & iLastRow）。
• 消除多余表头PDF：
  • 循环时跳过空单元格，并且添加判断If ws.Cells(Rows.Count, "A").End(xlUp).Row > 1——只有当筛选后有数据行（不止表头）时才导出PDF。
• 额外优化：
  • 添加了工作簿未保存时的提示，避免导出路径错误。
  • 自动清理临时工作表，保持工作簿整洁。
  • 增加导出完成的提示框，提升用户体验。

内容的提问来源于stack exchange，提问作者AshNev