VBA Excel Łączenie komórek w oparciu o wartość konkretnej komórki - excel-vba, vba, excel

Chciałbym zautomatyzować scalanie komórek na podstawie kolumny dla wielu kolumn na podstawie informacji w określonej kolumnie.

Na podstawie poniższego obrazu wartości w kolumnie cokreśli liczbę wierszy, które muszą zostać scalone dla Kolumn od A do K. Przy każdej zmianie wartości w Kolumnie C scalanie rozpoczyna się od nowa.

Private Sub MergeCells_C()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim rngMerge As Range, cell As Range
Set rngMerge = Range("C1:C1000") "Set the range limits here

MergeAgain:

For Each cell In rngMerge
If cell.Value = cell.Offset(1, 0).Value And IsEmpty(cell) = False Then
Range(cell, cell.Offset(1, 0)).Merge
GoTo MergeAgain
End If
Next

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Odpowiedzi:

To zadziałało dla mnie:

Sub MergeCellsByC()

Dim c As Range, sht As Worksheet, currV
Dim n As Long, rw As Range, r As Range

Set sht = ActiveSheet
Set c = sht.Range("C4") "adjust to suit....
currV = Chr(0)          "start with a dummy value

Do
If c.Value <> currV Then
If n > 1 Then
Set rw = c.EntireRow.Range("A1:K1") "A1:K1 relative to the row we"re on...
Application.DisplayAlerts = False
"loop across the row and merge the cells above
For Each r In rw.Cells
r.Offset(-n).Resize(n).Merge
Next r
Application.DisplayAlerts = True
End If
currV = c.Value
n = 1
Else
n = n + 1 "increment count for this value
End If

If Len(c.Value) = 0 Then Exit Do "exit on first empty cell
Set c = c.Offset(1, 0) "next row down
Loop

End Sub