一个表分成多个需要的表

zadang

求助大神，如何把表格中按名称列，分成（直销账单，商旅账单，分销账单）3个表，相应数据同步进去；其中直销账单包括名称列中的（微信小程序支付、WeHotel支付宝（联通）、会议积分支付、WeHotel支付宝、WeHotel云闪付），商旅账单包括（WeHotel企业月结），分销账单包括（美团支付、携程支付、去哪儿支付、艺龙支付、飞猪支付、抖音支付），每天给原表增加订单数量，分表自动增加，所有表格不需要求和

theking_wsz

手动建表    filter  筛选

mykitami

见附件，主要用filter函数，关键是构造条件参数

博爱风雨同舟

是不是你想要的？

3190496160

经常性的工作，还是考虑用代码来解决会好些吧，

3190496160

Sub 拆分()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
With Worksheets("Temp")
    .AutoFilterMode = False
    r = .Cells(.Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:i" & r)
End With
For Each sh In Sheets
    If sh.Index > 2 Then
        sh.Delete
    End If
Next sh
With Worksheets("对照表")
    .AutoFilterMode = False
    rs = .UsedRange.Rows.Count
    br = .Range("a1:c" & rs)
End With
For j = 1 To 3
    d.RemoveAll
    n = 0
    ReDim cr(1 To UBound(ar), 1 To UBound(ar, 2))
    For i = 2 To UBound(br)
        If br(i, j) <> "" Then
            d(br(i, j)) = ""
        End If
    Next i
    For i = 2 To UBound(ar)
        If d.exists(ar(i, 2)) Then
            n = n + 1
            For s = 1 To UBound(ar, 2)
                cr(n, s) = ar(i, s)
            Next s
        End If
    Next i
    If n > 0 Then
        Worksheets("Temp").Copy after:=Sheets(Sheets.Count)
        With ActiveSheet
            .Name = br(1, j)
            .UsedRange.Offset(1).Borders.LineStyle = 0
            .UsedRange.Offset(1) = Empty
            .[a2].Resize(n, UBound(cr, 2)) = cr
        End With
    End If
Next j
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "ok!"
End Sub

3190496160

原表.rar (35.57 KB, 下载次数: 2)

2024-4-21 09:48 上传

点击文件名下载附件

3190496160

vba代码完成的，仅供参考