Unmerge and fill values - if the cells are merged

2019-08-27 03:56发布

I have a VBA Code that Unmerges the merge cells and fill in the values for those cells.

I want the functionality of filling in the values to happen only if the merged cells belong to same column.

Sub UnMergeFill()

    Dim cell As Range, joinedCells As Range

    For Each cell In ThisWorkbook.ActiveSheet.UsedRange
        If cell.MergeCells Then
            Set joinedCells = cell.MergeArea
            cell.MergeCells = False
            ' I need an if loop here to check if the Range happens to be in the same column
            joinedCells.Value = cell.Value
        End If
    Next

    End Sub

For Example, I want all the cells to be unmerged. But only the Test2 values needs to be dragged down to those cells as they all belong to the same column. The test value shouldn't as it goes across different columns.

Sample Here

1条回答
Emotional °昔
2楼-- · 2019-08-27 04:45
Option Explicit

Sub UnMergeFill()

    Dim cell            As Range
    Dim joinedCells     As Range
    Dim MultiCol        As Boolean

    For Each cell In ThisWorkbook.ActiveSheet.UsedRange
        If cell.MergeCells Then

            '/ Multiple columns?
            If cell.MergeArea.Columns.Count <= 1 Then
                MultiCol = False
            Else
                MultiCol = True
            End If

            Set joinedCells = cell.MergeArea
            cell.MergeCells = False

            '/ Only when all the cells are in same column
            If Not MultiCol Then
                joinedCells.Value = cell.Value
            End If
        End If
    Next

End Sub
查看更多
登录 后发表回答