VBA宏可根据列值合并单元格

Question

我正在尝试根据列值使用VBA在excel中合并单元格。例如，在第一行，无论月份如何，都将这些单元格合并。我尝试了以下代码：

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

在这里，我将行固定为第一行，并在各列上进行迭代，并检查下一个单元格值是否与当前值相同。但是，在输出中它合并了不正确的单元格。我在这里想念什么？

Answer 1

应该这样工作...

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

它将改变这个……

进入这个……

Answer 2

这更容易理解。

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