求助大神如何实现自动合并

youlong8508

liulang0808 发表于 2021-5-22 06:07
楼主看看合并代码是否可以自行调整
如果还有问题，就上传附件

附件:人员表2.zip已上传，麻烦您再帮我看看

浜哄憳琛 (7.95 KB, 下载次数: 5)

2021-5-22 06:51 上传

点击文件名下载附件

liulang0808

Sub 按钮1_Click()
    On Error Resume Next
    Set Rng = Application.InputBox("请选择部门区域", "部门区域", , , , , , 8)
    If Err.Number <> 0 Then
        MsgBox "选择区域有误"
        Exit Sub
    End If
    If Rng.Columns.Count <> 1 Then
        MsgBox "选择区域多于1列"
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    c = Rng.Cells(1).Column
    Rng.Offset(0, 2).Copy Rng.Offset(0, 3)
    For j = Rng.Cells(Rng.Cells.Count).Row To Rng.Cells(1).Row Step -1
         If Cells(j, c) = Cells(j - 1, c) Then
            Cells(j - 1, c).Resize(2).Merge
            Cells(j - 1, c + 2) = Cells(j - 1, c + 2) + Cells(j, c + 2)
            Cells(j - 1, c + 2).Resize(2).Merge
            If Cells(j, c + 1) = Cells(j - 1, c + 1) Then
                Cells(j - 1, c + 1).Resize(2).Merge

                Cells(j - 1, c + 3) = Cells(j - 1, c + 3) + Cells(j, c + 3)
                Cells(j - 1, c + 3).Resize(2).Merge

            End If
        End If
    Next j
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

liulang0808

选择部门列有数据的区域，

youlong8508

liulang0808 发表于 2021-5-22 07:13
选择部门列有数据的区域，

感谢您的回复，能否不进行手动操作

liulang0808

youlong8508 发表于 2021-5-22 07:17
感谢您的回复，能否不进行手动操作

区域固定的话，把选择那部分直接设置成指定区域即可

youlong8508

liulang0808 发表于 2021-5-22 07:34
区域固定的话，把选择那部分直接设置成指定区域即可

麻烦您指点下，怎么把选择那部分设置成指定区域？

liulang0808

Sub 按钮1_Click()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Call test([b39:b48])
    Call test([b80:b89])
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
Sub test(rng As Range)
    c = rng.Cells(1).Column
    rng.Offset(0, 2).Copy rng.Offset(0, 3)
    For j = rng.Cells(rng.Cells.Count).Row To rng.Cells(1).Row Step -1
         If Cells(j, c) = Cells(j - 1, c) Then
            Cells(j - 1, c).Resize(2).Merge
            Cells(j - 1, c + 2) = Cells(j - 1, c + 2) + Cells(j, c + 2)
            Cells(j - 1, c + 2).Resize(2).Merge
            If Cells(j, c + 1) = Cells(j - 1, c + 1) Then
                Cells(j - 1, c + 1).Resize(2).Merge

                Cells(j - 1, c + 3) = Cells(j - 1, c + 3) + Cells(j, c + 3)
                Cells(j - 1, c + 3).Resize(2).Merge

            End If
        End If
    Next j
End Sub

zpy2

youlong8508 发表于 2021-5-22 06:52
附件:人员表2.zip已上传，麻烦您再帮我看看

select count(*) 行,部门,group_concat(人员类别),sum(人数) 部门人数,group_concat(人数) from (select 部门,人员类别,count(数量) as 人数,group_concat(数量,'</td><td>') 姓名 from 人员信息一维明细表 group by 部门,人员类别) group by 部门 order by 部门人数

youlong8508

zpy2 发表于 2021-5-22 07:56
select count(*) 行,部门,group_concat(人员类别),sum(人数) 部门人数,group_concat(人数) from (select  ...

感谢您的回复

youlong8508

liulang0808 发表于 2021-5-22 07:46
Sub 按钮1_Click()

    Application.ScreenUpdating = False

好的，谢谢，我试试