使用VBA实现Excel合并相同内容的相邻单元格

写算法的数据分析时生成了csv文件，为了方便查看需要对部分单元格进行合并。

原始的CSV文件用Excel打开有大量如下形式的子表：

而我希望处理之后变成如下格式：

在网上搜索了很久，大多只能对某一列进行操作，而我需要对整个表格的行列都进行这个操作。

除此之外，因为是数据分析的表格，我还希望只对非数字开头的单元格进行合并，即行列标题。

经过多次尝试，终于在以前从来没用过VBA的情况下把这个问题解决了……（写程序的过程中发现VBA的if居然没有短路操作，只好一层一层嵌套）

有两个值得注意的地方是，

首先，，Excel中合并之后的单元格只有左上角的单元格保存的数值，所以需要从右下角往左上角合并；

其次，如果先合并了列，再合并行的话，会把当前单元格左上角的单元格也一起合并，而事实上那个单元格可能与当前单元格值不相同，这时需要自己选择一个优先级，优先对行合并还是优先对列合并。

Sub MergeCellsWithSameValue()Application.ScreenUpdating = FalseApplication.DisplayAlerts = FalseDim r As IntegerDim c As IntegerSheet1.UsedRange.EntireRow.AutoFitSheet1.UsedRange.EntireColumn.AutoFitSheet1.UsedRange.HorizontalAlignment = xlCenterSheet1.UsedRange.VerticalAlignment = xlCenterFor r = Sheet1.UsedRange.Rows.Count To 1 Step -1For c = Sheet1.UsedRange.Columns.Count To 1 Step -1If Not IsEmpty(Cells(r, c)) ThenIf Not IsNumeric(Left(Cells(r, c).Value, 1)) ThenIf r > 1 ThenIf Not IsEmpty(Cells(r – 1, c).Value) ThenIf Cells(r, c) = Cells(r – 1, c) ThenRange(Cells(r, c), Cells(r – 1, c)).MergeGoTo NEXTLOOPEnd IfEnd IfEnd IfIf c > 1 ThenIf Not IsEmpty(Cells(r, c – 1).Value) ThenIf Cells(r, c) = Cells(r, c – 1) ThenRange(Cells(r, c), Cells(r, c – 1)).MergeGoTo NEXTLOOPEnd IfEnd IfEnd IfEnd IfEnd IfNEXTLOOP:NextNextApplication.DisplayAlerts = TrueApplication.ScreenUpdating = TrueEnd Sub

Excel 2013中测试有效。

GoTo NEXTLOOP

人生的失败往往是在关键时刻少了坚持。