VBA-在数据间隙之间插入合并行

Question

我目前有一个宏，当E列中的值更改时，该宏将插入3行（课程部门）。在3行中，我尝试合并中间行并将部门添加到此行中。我不知道如何合并它，任何帮助将不胜感激。

With Range("e" & myHeader + 2, Range("e" & Rows.Count).End(xlUp)).Offset(, 1)
.Formula = _
"=if(and(r[-1]c[-1]<>"""",rc[-1]<>"""",r[-1]c[-1]<>rc[-1])," & _
"if(r[-1]c=1,""a"",1),"""")"
.Value = .Value
On Error Resume Next
For i = 1 To 3
    .SpecialCells(2, 1).EntireRow.Insert
    .SpecialCells(2, 2).EntireRow.Insert
Next

当前情况如下：

这就是我想要的：

Answer 1

在插入或删除行时，请从下至上进行操作。一些简单的偏移和调整大小就足以插入三行，合并单元格并传输值。

Option Explicit

Sub insertDept3()

    Dim i As Long

    With Worksheets("sheet10")
        For i = .Cells(.Rows.Count, "E").End(xlUp).Row - 1 To 1 Step -1
            If .Cells(i, "E").Value <> .Cells(i + 1, "E").Value Or i = 1 Then
                .Cells(i + 1, "A").Resize(3, 5).Insert shift:=xlDown
                .Cells(i + 2, "A").Resize(1, 5).Merge
                .Cells(i + 2, "A") = .Cells(i + 4, "E").Value
            End If
        Next i
    End With

End Sub

我将保留单元格对齐方式和字体格式。

Answer 2

下面的代码循环E列，在值更改时导入三行，将A列合并到E列，并在中间行导入并格式化值。

尝试：

Option Explicit

Sub test()

    Dim i As Long, Lastrow As Long
    Dim Department  As String, NextDepartment As String

    With ThisWorkbook.Worksheets("Sheet1")
        Lastrow = .Cells(.Rows.Count, "E").End(xlUp).Row

        For i = Lastrow To 2 Step -1
            Department = .Range("E" & i).Value
            NextDepartment = .Range("E" & i).Offset(-1, 0).Value
            If Department <> NextDepartment Then
                .Rows(i).EntireRow.Resize(3).Insert
                .Range("A" & i + 1 & ":E" & i + 1).Merge
                With .Range("A" & i + 1)
                    .Value = Department
                    .Font.Bold = True
                    .HorizontalAlignment = xlLeft
                    .VerticalAlignment = xlCenter
                End With
            End If
        Next i

    End With

输出：