Excel如何根据字段将数据创建到不同表格？

0428_hai

非常感谢大家，现在重新整理了下需求，并重发一贴，参见
http://club.excelhome.net/thread-1519252-1-1.html

祝洪忠-

http://yyb.excelhome.net/
免费工具 试试

0428_hai

祝洪忠- 发表于 2020-1-25 21:36
http://yyb.excelhome.net/
免费工具 试试

可以实现拆分，但是无法在主表更新时子表也实现功能

3190496160

Sub chaifen()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    For Each sh In Sheets
        If sh.Index > 1 Then sh.Delete
    Next sh
Application.DisplayAlerts = True
Set d = CreateObject("scripting.dictionary")
ar = Sheet1.[a1].CurrentRegion
For i = 2 To UBound(ar)
    If Trim(ar(i, 23)) <> "" Then
        d(Trim(ar(i, 23))) = ""
    End If
Next i
Dim rng As Range
For Each k In d.keys
    Sheet1.Copy after:=Sheets(Sheets.Count)
    Set sht = Sheets(Sheets.Count)
    sht.Name = k
    For i = 2 To UBound(ar)
        If Trim(sht.Cells(i, 23)) <> k Then
            If rng Is Nothing Then
                Set rng = sht.Rows(i)
            Else
                Set rng = Union(rng, sht.Rows(i))
            End If
        End If
    Next i
    If Not rng Is Nothing Then rng.Delete
    For Each s In sht.Shapes
        s.Delete
    Next s
    Set rng = Nothing
Next k
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

完全保留总表的所有格式拆分，
总表数据更新，点击按钮，重新拆分一下即可
不明白，为什么，总是有人在追求实时更新呢？？？
2014届11班成绩跟踪分析.zip (28.94 KB, 下载次数: 11)

2020-1-26 08:48 上传

点击文件名下载附件

zpy2

0428_hai 发表于 2020-1-25 21:49
可以实现拆分，但是无法在主表更新时子表也实现功能

如果需要多人查询，最好是用web方式。

wanghailong8203

数据透视表下“显示报表筛选页”就可以实现，主表更新点击数据刷新就可以了

准提部林

Sub TEST()
Dim i&, j%, xD, xS As Worksheet, xArea As Range, T$
Set xS = Sheets("Sheet1")
Set xArea = Range(xS.[W1], xS.Cells(Rows.Count, 1).End(3))
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = Sheets.Count To 2 Step -1
    Sheets(i).Delete
Next i
Set xD = CreateObject("Scripting.Dictionary")
For i = 2 To xArea.Rows.Count
    T = xArea(i, 23)
    If T = "" Or Val(xD(T)) > 0 Then GoTo 101 Else xD(T) = 1
    With Sheets.Add(after:=Sheets(Sheets.Count))
         .Name = T
         xArea.AutoFilter Field:=23, Criteria1:=T
         xArea.Copy .[A1]
         For j = 1 To 23
             .Cells(1, j).ColumnWidth = xArea(1, j).ColumnWidth
         Next j
    End With
101: Next i
xS.Select: xS.ShowAllData
End Sub

原汁原味的格式設置~~