Use VBA to implement Excel to merge adjacent cells of the same content

Write the data analysis of the algorithm generated a CSV file, in order to make it easier to see the need to merge some cells.

The original CSV file opens with Excel a large number of sub-tables in the following form:

And I want to deal with the following format:

Searching the internet for a long time, most can only work on a single column, and I need to do this for the entire table row.

Besides, because it's a table of data analysis, I also want to merge only cells that are not numbers, that is, row and column headings.

After many attempts, finally in the past has never used VBA before the case to solve the problem ...
(in the process of writing the program found that VBA if there is no short-circuit operation, had to layer a layer of nesting)

There are two noteworthy areas,

First, the merged cells in Excel have only the values stored in the upper-left cell, so they need to be merged from the lower-right corner to the upper-left corner;

Second, if you merge the columns first, and then merge the rows, the cells in the upper-left corner of the current cell are merged together, and in fact the cell may not be the same as the current cell value.
At this point, you need to choose a priority, priority to the row merge or priority to the column merge.

Sub mergecellswithsamevalue () application.screenupdating = False Application.DisplayAlerts = False Dim R as I Nteger Dim C as Integer Sheet1.UsedRange.EntireRow.AutoFit Sheet1.UsedRange.EntireColumn.AutoFit sheet1.us Edrange.horizontalalignment = Xlcenter Sheet1.UsedRange.VerticalAlignment = Xlcenter for r = Sheet1.UsedRange.Ro Ws.                Count to 1 Step-1 for C = Sheet1.UsedRange.Columns.Count to 1 Step-1 If not IsEmpty (Cells (R, c)) then If not IsNumeric (Cells (R, c). Value, 1)) then if R > 1 Then if not IsEmpty (Cells (R-1, C).  Value) then If cells (r, c) = Cells (r-1, C) then Range (Cells (R, c), Cells (R-1, C)).                    Merge GoTo Nextloop End If End If End if if C > 1 then if not IsEMpty (Cells (R, C-1).  Value) then If cells (r, c) = Cells (R, c-1) and then Range (Cells (R, c), Cells (R, C-1)).                    Merge GoTo Nextloop End If End If End If End If End ifnextloop:next Next application.displayalerts = Tru E application.screenupdating = TrueEnd Sub

Test is valid in Excel 2013.

Use VBA to implement Excel to merge adjacent cells of the same content