Excel VBA宏按客户分组导出行至PDF时每页仅一行的问题求助

嗨，我完全懂你的困扰！现在你的宏确实能按客户分组建PDF，但每一行单独占一页的问题确实头疼。咱们来拆解问题，然后调整代码搞定它。

问题根源分析 #

你当前的代码是把单个整行（ws.rows(num)）用Union合并后导出，Excel在打印整行的时候，默认会把每一行视为独立的打印区域，所以就出现了每行一页的情况。另外，直接导出行对象也没限定要打印的列范围，这也可能影响分页逻辑。

解决思路 #

核心是不要导出整行，而是导出对应行的目标列区域（也就是你需要的A到I列），同时调整打印设置，让Excel自动适配页面，把同一客户的所有行尽量放在同一页（行数过多时自动分页，而不是强制每行一页）。

修改后的完整代码 #

Sub ExportToPDF()
    'Declare variables
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim dict As Object
    
    'Set the worksheet you want to search
    Set ws = ThisWorkbook.Worksheets("Requests")
    'Set the range you want to search (A6:I30)
    Set rng = ws.Range("A6:I30")
    
    'Create a dictionary object to store the values of column B and their corresponding rows
    Set dict = CreateObject("Scripting.Dictionary")
    
    'Loop through each cell in column B of the range
    For Each cell In rng.Columns(2).Cells
        'Check if the cell value is not empty
        If cell.Value <> "" Then
            'If the value already exists, append the row number
            If dict.Exists(cell.Value) Then
                dict(cell.Value) = dict(cell.Value) & "," & cell.Row
            Else
                'Add new key with the row number
                dict.Add cell.Value, cell.Row
            End If
        End If
    Next cell
    
    'Loop through each customer in the dictionary
    Dim Key As Variant
    Dim rows As Range
    Dim ListRows As Variant
    Dim num As Variant
    Dim count As Integer
    
    For Each Key In dict.Keys
        count = 1
        ListRows = Split(dict(Key), ",")
        Set rows = Nothing 'Reset range for each customer
        
        For Each num In ListRows
            '取当前行的A到I列区域，而不是整行
            Dim currentRowRange As Range
            Set currentRowRange = ws.Range("A" & num & ":I" & num)
            
            If count = 1 Then
                Set rows = currentRowRange
                count = count + 1
            Else
                Set rows = Union(rows, currentRowRange)
            End If
        Next num
        
        '临时设置打印区域和缩放，确保列适配一页，行自动分页
        With ws.PageSetup
            .PrintArea = rows.Address
            .FitToPagesWide = 1 '强制列宽适配一页
            .FitToPagesTall = False '行高自动分页，不强制一页
        End With
        
        '导出PDF
        rows.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:="C:\temp\" & Key & ".pdf", _
            Quality:=xlQualityStandard, _
            IgnorePrintAreas:=False '使用我们设置的打印区域
    Next Key
    
    '恢复默认打印区域（可选）
    ws.PageSetup.PrintArea = ""
End Sub

关键改动说明 #

• 替换整行为目标列区域：把ws.rows(num)改成ws.Range("A" & num & ":I" & num)，这样我们只导出需要的列，而不是整个工作表的行，避免Excel自动拆分每页一行。
• 添加打印设置：通过PageSetup强制列宽适配一页，行则根据内容自动分页，这样同一客户的所有行会尽量放在同一页，内容过多时才会分到下一页。
• 重置区域对象：每次处理新客户时重置rows对象，避免残留之前的区域。
• 明确忽略打印区域参数：导出时设置IgnorePrintAreas:=False，确保使用我们临时设置的打印区域。

另外提个小细节：你描述里说客户名在A列，但代码里用的是rng.Columns(2)也就是B列，如果是笔误的话，记得把Columns(2)改成Columns(1)哦！

备注：内容来源于stack exchange，提问作者TechnologyGeek