如何让EXCEL自动按关键字筛选,依次打印?

2025-03-21 10:56:10
推荐回答(1个)
回答1:

这个是可以用VBA实现的,先按照批次把表分成N个分表,再选中所有分表一次性打印出来。

你试下这个代码:

Sub XinJian() '按列新建工作表
On Error Resume Next
Set Rng = Application.InputBox("选择按哪一列进行新建工作表。" & vbNewLine & vbNewLine & "请确保第一行为标题!", Default:=ActiveCell.Address, Title:=123, Type:=8)
     If Err <> 0 Then
        MsgBox "请选择一个单元格对象。", vbInformation, 123
        On Error GoTo 0
        Exit Sub
     End If
On Error GoTo 0

L = Rng.Column
Set d = CreateObject("Scripting.Dictionary")
Set Rng = Range(Cells(2, L), Cells(65535, L).End(xlUp))
Set sht = Rng.Parent
    Set Temp = sht.Range(Cells(1, 1), sht.Cells.SpecialCells(xlCellTypeLastCell))
    
    For Each n In Temp
        If n.MergeCells = True Then
            MsgBox "请取消所有合并单元格!", vbInformation, 123
            Exit Sub
        End If
    Next n
    
    For Each n In Rng
        d(n.Value) = ""
    Next n
    
    For i = 0 To d.Count - 1 Step 1
        Worksheets.Add after:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = CStr(d.keys()(i))
        sht.Rows(1).Copy ActiveSheet.[a1] '复制表头
        sht.Rows(1).Copy
        [a1].PasteSpecial Paste:=xlPasteColumnWidths '列宽
    Next i
    
    sht.Activate
    For Each n In Rng
        n.EntireRow.Copy Worksheets(CStr(n.Value)).Cells(65535, L).End(xlUp).Offset(1, 1 - L)
    Next n
    sht.[a1].Select
    
    Set Rng = Nothing
    Set d = Nothing
    Set sht = Nothing
    Set Temp = Nothing
End Sub