基于特定单元格值的VBA Excel合并单元格

时间:2015-11-29 17:52:49

标签: excel-vba vba excel

我想根据特定列中的信息自动将基于列的单元格合并为多列。

根据下面的图片,列c中的值将确定列A到K需要合并在一起的行数。对于C列中值的每次更改 - 合并将再次开始。

enter image description here

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

1 个答案:

答案 0 :(得分:0)

这对我有用:

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