求助：拆分sheet

prowl

需求：根据表里G、H、I、J、K列的表头名字，分别生成对应的sheet，并且每个sheet的名字就是表头的名字。大概就是名字为“多”的sheet那样的形式。

表最好能根据 “总表” 不断添加的行的内容，新生成的各个sheet内容可以依次添加新的内容。先谢谢大神们了

gwjkkkkk

gwjkkkkk

请参考。。。

gwjkkkkk

请参考。。。

prowl

gwjkkkkk 发表于 2024-11-17 19:57
请参考。。。

感谢大神帮助

prowl

gwjkkkkk 发表于 2024-11-17 19:57
请参考。。。

想问下，为何拆分生成的“报废”那个sheet里的数好像不对。拆分出来的每个sheet为何里面都在表头行，多了一个F6，麻烦大神，再给看看？

gwjkkkkk

prowl 发表于 2024-11-17 20:17
想问下，为何拆分生成的“报废”那个sheet里的数好像不对。拆分出来的每个sheet为何里面都在表头行，多了 ...

这个是SQL折分的原因，格式可以调整。

prowl

gwjkkkkk 发表于 2024-11-17 20:44
这个是SQL折分的原因，格式可以调整。

好的，等我再试一试，非常感谢大神的帮助

gwjkkkkk

prowl 发表于 2024-11-17 20:17
想问下，为何拆分生成的“报废”那个sheet里的数好像不对。拆分出来的每个sheet为何里面都在表头行，多了 ...

Option Explicit
Sub TEST2()
    Dim ar, br, i&, j&, r&, k&, wks As Worksheet
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    With Worksheets("总表")
        r = .Cells(.Rows.Count, "A").End(xlUp).Row
        ar = .Range("A1:K" & r).Value
        For Each wks In Worksheets
            If wks.Name <> .Name Then wks.Delete
        Next
    End With
   
    ReDim br(1 To UBound(ar), 1 To 7) As String
    For j = 1 To 6: br(1, j) = ar(1, j): Next
    For j = 7 To UBound(ar, 2)
        br(1, 7) = ar(1, j): r = 1
        For i = 2 To UBound(ar)
            If Len(Trim(ar(i, j))) Then
                r = r + 1
                For k = 1 To 6
                    br(r, k) = ar(i, k)
                Next k
                br(r, 7) = ar(i, j)
            End If
        Next i
        With Worksheets.Add(after:=Worksheets(Worksheets.Count))
            .Name = ar(1, j)
            .[A1].Resize(r, UBound(br, 2)) = br
            .Cells.EntireColumn.AutoFit
        End With
    Next j
   
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

prowl 发表于 2024-11-17 20:48
好的，等我再试一试，非常感谢大神的帮助

用数组法再写一下。。。