济南地铁建设合肥seo结算

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

如下图：
原Excel

目的Excel

Sub TestCopyFunction()Application.ScreenUpdating = FalseOn Error GoTo ErrorHandlerDim startRow As Long: startRow = 1Dim startCol As Long: startCol = 1Dim endRow As Long: endRow = 24Dim endCol As Long: endCol = 6Dim copyTimes As Long: copyTimes = 2CopyRowsInMergedCells Sheet1, startRow, startCol, endRow, endCol, copyTimesExitSub:Application.ScreenUpdating = TrueExit Sub
ErrorHandler:MsgBox "错误 " & Err.Number & ": " & Err.Description, vbCriticalGoTo ExitSub
End SubFunction 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 LongFor i = startCol To endColj = startRowDo While j <= endRowtotalmergeRowCount = 0mergeRowCount = 0If 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.CountElsemergeRowCount = 1End IfFor k = 1 To copyTimesRows((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 + mergeRowCountNext kendRow = endRow + totalmergeRowCountj = j + totalmergeRowCount + mergeRowCount - 1End Ifj = j + 1LoopNext i'合并单元格For i = startCol To endColj = startRowDo While j <= endRowmergeRowCount = 0'空单元格+一致单元格For k = j To endRowIf ws.Cells(k, i).value = "" Or ws.Cells(k, i).value = ws.Cells(j, i).value ThenmergeRowCount = mergeRowCount + 1ElseExit ForEnd IfNext k'可以合并If mergeRowCount > 1 Then'计算左侧单元格的合并范围If i > startCol ThenFor k = j + 1 To k + mergeRowCountIf ws.Cells(k, i - 1).value <> "" ThenExit ForEnd IfNext k'如果超过了范围，则订正范围If j + mergeRowCount - 1 <= k - 1 Thenk = j + mergeRowCountEnd IfEnd IfApplication.DisplayAlerts = FalseWith ws.Range(Cells(j, i), Cells(k - 1, i)).Merge.HorizontalAlignment = xlLeft.VerticalAlignment = xlCenterEnd WithApplication.DisplayAlerts = Truej = kElsej = j + 1End IfLoopNext i
End Function