根据组别将多列数据分区排列

GUQLM

感谢论坛的各位老师关注和帮助。


我经常要将透视到的数据分区排列然后分别处理。分开数据的方法就是拷贝粘贴。能否请论坛的老师编写程序，可以提高效率。

1 源数据为A-F列（列数可能不止6列）；行数为3-6千行；保留源数据；

需求：

2 根据人员组别（4组或更多组，组数写在G2）拷贝各组的数据到新的列区（颜色变灰色的区域）；

根据组别将多列数据分开.rar (38.43 KB, 下载次数: 13)

2024-3-16 09:01 上传

点击文件名下载附件

3190496160

Sub Mycopy()
Dim rr()
With ActiveSheet
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    y = .Cells(1, Columns.Count).End(xlToLeft).Column
    ar = .Range("a1:f" & r)
    zh = Replace(.Cells(1, y).Address(0, 0), "1", "")
    .Columns("h:" & zh).Delete
    ReDim rr(1 To UBound(ar))
    For i = 2 To UBound(ar)
        If InStr(ar(i, 1), "分组") > 0 Then
            m = m + 1
            rr(m) = i + 1
        End If
    Next i
    If m = "" Then MsgBox "没有分组标识！": End
    m = m + 1
    rr(m) = r + 1
    y = 8
    For i = 1 To m - 1
        ks = rr(i)
        js = rr(i + 1) - 2
        .Range("a1:f1").Copy .Cells(1, y)
        .Range(.Cells(ks, 1), .Cells(js, 6)).Copy .Cells(2, y)
        y = y + 7
    Next i
End With
MsgBox "ok!"
End Sub

3190496160

根据组别将多列数据分开-求助.rar (44.75 KB, 下载次数: 16)

2024-3-16 09:30 上传

点击文件名下载附件

GUQLM

3190496160 发表于 2024-3-16 09:30

感谢3190496160老师出手相助，程序运行快，结果准确。谢谢您。

如果允许，能否保留各组的组别名称，例如分组1，分组2，分组3......，方便识别，我手工补也可以。

另外，数据源有时会多几列，程序就只转前面六列了。方便修改吗？（补充：我尝试修改程序后可以拷贝多些列了，但是不会从组别拷贝）

无论如何都非常感谢您。

3190496160

GUQLM

3190496160 发表于 2024-3-17 09:42

感谢老师百忙中指点我。我马上学习和试验。

GUQLM

3190496160 发表于 2024-3-17 09:42

问题完美解决，再次感谢老师指点。