VBA宏基于列值合并单元格

Question

I'm trying to merge cells in excel using VBA based on the column value. For instance, on row one, wherever the month is the same, merge those cells. I've tried the following code :

Sub Main()

Dim j As Long

    For j = 1 To 13
        If StrComp(Cells(1, j), Cells(1, j + 1), vbTextCompare) Then
            Range(Cells(1, j), Cells(1, j + 1)).Merge
        End If

    Next j

End Sub

Here, I'm keeping the row fixed as the first row and iterating over the columns and checking if the next cell value is same as the current value. However, in the output it's merging incorrect cells. What am I missing here?

Answer 1

Should work like this …

Option Explicit

Public Sub MergeSameValuesInRow()
    Const iRow As Long = 1         'the row number
    Const FirstColumn As Long = 1  'first column with data in iRow

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")  'define your worksheet

    Dim LastColumn As Long  'find last used column in iRow
    LastColumn = ws.Cells(iRow, ws.Columns.Count).End(xlToLeft).Column

    Dim StartCell As Range  'remember the start cell (first occurence of a new value)
    Set StartCell = ws.Cells(iRow, FirstColumn)

    Dim iCol As Long
    For iCol = FirstColumn + 1 To LastColumn + 1  'loop through columns in iRow
        If ws.Cells(iRow, iCol).Value <> StartCell.Value Then  'if value changed …
            Application.DisplayAlerts = False  'hide merging messages
            ws.Range(StartCell, ws.Cells(iRow, iCol - 1)).Merge  'merge from start cell until one before value change
            Application.DisplayAlerts = True

            Set StartCell = ws.Cells(iRow, iCol)  'set start cell to the next value
        End If
    Next iCol
End Sub

It will change this …

into this …

Answer 2

This is easier to understand.

Application.DisplayAlerts = False
    With ThisWorkbook.Sheets("Sheet1")
        For i = 13 To 2 Step -1 'Loop from the last cell, and stop at the second column 
            If .Cells(1, i).Value = .Cells(1, i).Offset(, -1).Value Then
                .Range(.Cells(1, i), .Cells(1, i).Offset(, -1)).Merge
            End If
        Next i
    End With
Application.DisplayAlerts = True