合并不同范围的单元格

我有以下几点：

我期待以下几点：

我正在使用这个代码：

Sub merge_cells() Application.DisplayAlerts = False Dim r As Integer Dim mRng As Range Dim rngArray(1 To 4) As Range r = Range("A65536").End(xlUp).Row For myRow = r To 2 Step -1 If Range("A" & myRow).Value = Range("A" & (myRow - 1)).Value Then For cRow = (myRow - 1) To 1 Step -1 If Range("A" & myRow).Value <> Range("A" & cRow).Value Then Set rngArray(1) = Range("A" & myRow & ":A" & (cRow + 0)) Set rngArray(2) = Range("B" & myRow & ":B" & (cRow + 0)) Set rngArray(3) = Range("C" & myRow & ":C" & (cRow + 0)) Set rngArray(4) = Range("D" & myRow & ":D" & (cRow + 0)) For i = 1 To 4 Set mRng = rngArray(i) mRng.Merge With mRng .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 90 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End With Next i myRow = cRow + 2 Exit For End If Next cRow End If Next myRow Application.DisplayAlerts = True End Sub 

我得到的是：

问： 如何做到这一点？

实际上在我的原始数据中，前三列每行从第3行开始有88行，列D应该每四行合并一次。

Answer 1

您的代码不以任何方式区分不同的列。 如果您知道要合并多less行，您可以简单地search单元格，然后根据列号进行合并。 这是一个这样的方法，它使用一对数组来跟踪要合并的行数，然后应用什么格式。

您将需要更改数组定义中的行数。 听起来像你想要的（87,87,87,3）根据您的编辑。 我做了（11,11,11,3）来匹配你的例子。 这是你的代码真正的修复; 它使用Column号来确定要合并的行数。

我也只是在电子表格中input了一些值，并使用SpecialCells来获取只有值的单元格。 如果你的数据符合你的例子，这工作正常。

编辑包括首先根据OP请求取消合并单元格。

 Sub MergeAllBasedOnColumn() Dim rng_cell As Range Dim arr_rows As Variant Dim arr_vert_format As Variant 'change these to the actual number of rows 'one number for each column A, B, C, D arr_rows = Array(11, 11, 11, 3) 'change these if the formatting is different than example arr_vert_format = Array(True, True, True, False) 'unmerge previously merged cells Cells.UnMerge 'get the range of all cells, mine are all values For Each rng_cell In Range("A:D").SpecialCells(xlCellTypeConstants) 'ignore the header row If rng_cell.Row > 2 Then 'use column to get offset count Dim rng_merge As Range Set rng_merge = Range(rng_cell, rng_cell.Offset(arr_rows(rng_cell.Column - 1))) 'merge cells rng_merge.Merge 'apply formatting If arr_vert_format(rng_cell.Column - 1) Then 'format for the rotated text (columns A:C) With rng_merge .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 90 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext End With Else 'format for the other cells (column D) With rng_merge .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False End With End If End If Next rng_cell End Sub 

之前

后