在空行中写下部门编号和部门总数

Question

我有文件，我希望在B列的值发生变化时插入三行，然后我想写＆＃34; Department Total：＆＃34;在我插入的第一个空白行，并希望在第三个空白行中连接（＆＃34;部门＆＃34;，$ B5，＆＃34;＃＆＃34;）。 我想为数据中的每组空行执行此操作。 我能够连接第三行的连接部分。但是不能写＆＃34;部门总数：＆＃34;在每一组的第一个空白行

我已使用此代码在列B的值更改时插入行： -

Sub InsertRowsAtValueChange()

    Dim Rng As Range
    Dim WorkRng As Range
    On Error Resume Next
    xTitleId = "Enter the Range"
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
    Application.ScreenUpdating = False
    For i = WorkRng.Rows.Count To 2 Step -1
        If WorkRng.Cells(i, 2).Value <> WorkRng.Cells(i - 1, 2).Value Then
            WorkRng.Cells(i, 2).EntireRow.Insert
            Range("A" & i).Value = "=CONCAT(""Department "",R[1]C[1],""#"")"
            WorkRng.Cells(i, 2).EntireRow.Insert
            WorkRng.Cells(i, 2).EntireRow.Insert
        End If
    Next
    Application.ScreenUpdating = True
    End Sub

但我无法在这些空行中编写上述细节的代码。

任何人都可以解决这个问题吗？

Answer 1

这可能是你想要的东西。它只是正确计算行数，你可以一次插入3行。

Option Explicit

Public Sub InsertRowsAtValueChange()
    Dim xTitleId As String
    xTitleId = "Enter the Range"

    Dim WorkRng As Range
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)

    Application.ScreenUpdating = False

    Dim LastDepartmentRow As Long
    LastDepartmentRow = (WorkRng.Rows.Count + WorkRng.Row - 1)

    Dim i As Long
    For i = LastDepartmentRow To 2 Step -1
        If WorkRng.Cells(i, 2).Value <> WorkRng.Cells(i - 1, 2).Value Then
            WorkRng.Cells(i, 2).Resize(RowSize:=3).EntireRow.Insert 'add 3 empty rows

            'write subtotal below
            Range("A" & LastDepartmentRow + 4).Value = "Department Total:"
            Range("C" & LastDepartmentRow + 4).Value = "=SUM(C" & i + 3 & ":C" & LastDepartmentRow + 3 & ")"
            Rows(LastDepartmentRow + 4).Font.Bold = True

            'write headline above
            Range("A" & i + 2).Value = "=CONCATENATE(""Department "",R[1]C[1],""#"")"
            Rows(i + 2).Font.Bold = True

            LastDepartmentRow = i - 1 'remember last subtotal department data row
        End If
    Next i

    Application.ScreenUpdating = True
End Sub