怎么把表格某个字段中不同的内容筛选出来（批量）单独按照筛选出来的名字保存成单...

yanjunsjp

怎么把表格字段中不同的内容筛选出来（批量）单独按照筛选出来的名字保存成单个文件，不知道我这样表述是否明白啦

例如，文件中，把会计1班筛选出来单独保存，会计2班筛选出来单独保存，……

HSIAOQIANG

透視表---顯示報表篩選頁

xiangzi728

3190496160

Sub 拆分为工作簿()
Application.ScreenUpdating = False
Dim ar As Variant, br As Variant
Dim i As Long
Dim arr()
Dim d As Object
Dim sh As Worksheet
Dim rng As Range
Set sh = ThisWorkbook.ActiveSheet
Set d = CreateObject("scripting.dictionary")
With sh
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:az" & r)
End With
For i = 2 To UBound(ar)
    If Trim(ar(i, 3)) <> "" Then
        d(Trim(ar(i, 3))) = ""
    End If
Next i
For Each k In d.keys
    sh.Copy
    Set wb = ActiveWorkbook
    With wb.Worksheets(1)
        For i = 2 To UBound(ar)
            If Trim(.Cells(i, 3)) <> k Then
                If rng Is Nothing Then
                    Set rng = .Rows(i)
                Else
                    Set rng = Union(rng, .Rows(i))
                End If
            End If
        Next i
        For Each sp In .Shapes
            sp.Delete
        Next sp
    End With
    If Not rng Is Nothing Then rng.Delete
    Set rng = Nothing
    wb.SaveAs Filename:=ThisWorkbook.Path & "\" & k & ".xlsx"
    wb.Close
Next k
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

问题求助.rar (14.48 KB, 下载次数: 3)

2022-11-23 09:35 上传

点击文件名下载附件

3190496160

也可以到这个帖子的16楼下载灵活拆分工具，下载就能用
https://club.excelhome.net/thread-1533849-1-1.html

yanjunsjp

3190496160 发表于 2022-11-23 09:35

非常感谢你的帮助，虽然我不懂里面的语句，但是你的表格我可以直接拿来用了，
不过，我想问一下，语句中哪个段是对"C“列进行筛选的呀？如果我不是C列，改成D列或其他，需要修改哪个字符呀

3190496160

yanjunsjp 发表于 2022-11-23 13:00
非常感谢你的帮助，虽然我不懂里面的语句，但是你的表格我可以直接拿来用了，
不过，我想问一下，语 ...

修改三句代码即可，
If Trim(ar(i, 3)) <> "" Then
        d(Trim(ar(i, 3))) = ""

If Trim(.Cells(i, 3)) <> k Then

yanjunsjp

3190496160 发表于 2022-11-23 13:04
修改三句代码即可，
If Trim(ar(i, 3))  "" Then
        d(Trim(ar(i, 3))) = ""

谢谢