VBA 复制指定次数的List

实现功能如下：
excel指定行列范围内的所有单元格
规则1：从第一列开始到最后一列，每一列的每一行的单元格包含List<的话，竖着复制指定次数
规则2：规则1复制后，每一次复制后把(0)替换为(1)(2)等等序号
规则3：从第一列开始到最后一列，每一列的每一行连续相同的值，合并单元格。
规则4：规则3的合并单元，右侧的合并范围不能超过左侧的范围

如下图：
原Excel

目的Excel

Sub TestCopyFunction()
    Application.ScreenUpdating = False
    On Error GoTo ErrorHandler
    
    Dim startRow As Long: startRow = 1
    Dim startCol As Long: startCol = 1
    Dim endRow As Long: endRow = 24
    Dim endCol As Long: endCol = 6
    Dim copyTimes As Long: copyTimes = 2
    
    CopyRowsInMergedCells Sheet1, startRow, startCol, endRow, endCol, copyTimes
    
ExitSub:
    Application.ScreenUpdating = True
    Exit Sub
ErrorHandler:
    MsgBox "错误 " & Err.Number & ": " & Err.Description, vbCritical
    GoTo ExitSub
End Sub

Function CopyRowsInMergedCells(ws As Worksheet, startRow As Long, startCol As Long, endRow As Long, endCol As Long, copyTimes As Long)
    Dim mergeRowCount As Long, totalmergeRowCount As Long
    
    For i = startCol To endCol
        j = startRow
        Do While j <= endRow
            totalmergeRowCount = 0
            mergeRowCount = 0
            If InStr(1, ws.Cells(j, i).value, "List<", vbTextCompare) > 0 Then
                '如果是合并单元格
                If ws.Cells(j, i).MergeCells Then
                    '取得合并单元格的行数
                    mergeRowCount = ws.Cells(j, i).mergeArea.Rows.Count
                Else
                    mergeRowCount = 1
                End If
                
                For k = 1 To copyTimes
                    Rows((j + k * mergeRowCount) & ":" & (j + k * mergeRowCount)).Resize(mergeRowCount).Insert '在第5行下方插入3行空白行?:ml-citation{ref="4,6" data="citationList"}
                    
                    Range(Cells(j, i), Cells(j + mergeRowCount - 1, endCol)).Copy Destination:=Cells(j + k * mergeRowCount, i)
                    
                    Cells(j + k * mergeRowCount, i).value = Replace(Cells(j + k * mergeRowCount, i).value, "(0)", "(" & k & ")")
                    
                    totalmergeRowCount = totalmergeRowCount + mergeRowCount
                Next k
                
                endRow = endRow + totalmergeRowCount
                j = j + totalmergeRowCount + mergeRowCount - 1
            End If
            j = j + 1
        Loop
    Next i

    '合并单元格
    For i = startCol To endCol
        j = startRow
        Do While j <= endRow
            mergeRowCount = 0
            '空单元格+一致单元格
            For k = j To endRow
                If ws.Cells(k, i).value = "" Or ws.Cells(k, i).value = ws.Cells(j, i).value Then
                    mergeRowCount = mergeRowCount + 1
                Else
                    Exit For
                End If
            Next k
            
            '可以合并
            If mergeRowCount > 1 Then
                '计算左侧单元格的合并范围
                If i > startCol Then
                    For k = j + 1 To k + mergeRowCount
                        If ws.Cells(k, i - 1).value <> "" Then
                            Exit For
                        End If
                    Next k
                
                    '如果超过了范围，则订正范围
                    If j + mergeRowCount - 1 <= k - 1 Then
                        k = j + mergeRowCount
                    End If
                End If
                
                Application.DisplayAlerts = False
                With ws.Range(Cells(j, i), Cells(k - 1, i))
                        .Merge
                        .HorizontalAlignment = xlLeft
                        .VerticalAlignment = xlCenter
                End With
                Application.DisplayAlerts = True
                j = k
            Else
                j = j + 1
            End If
        Loop
    Next i
End Function