VBA代码需求：仅对同列合并单元格取消合并后填充值

Hey there! Let's tackle this specific VBA task you need: unmerging all cells in your worksheet, but only filling the original value within the same column of the original merged range. For cross-column merged cells, we’ll just unmerge them and leave only the top-left cell with the original value (no cross-column filling).

The VBA Code #

Sub UnmergeAndFillSameColumnOnly()
    Dim ws As Worksheet
    Dim mergeArea As Range
    Dim cellValue As Variant
    Dim isSingleColumn As Boolean
    
    ' Set your target worksheet (replace "YourSheetName" with your actual sheet name if needed)
    Set ws = ActiveSheet ' Or use Sheets("YourSheetName") for a specific sheet
    
    ' Speed up execution by disabling screen updates and events
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    ' Loop through every merged area in the worksheet's used range
    For Each mergeArea In ws.UsedRange.MergeAreas
        ' Grab the value from the top-left cell of the merged area (the only one with data pre-unmerge)
        cellValue = mergeArea.Cells(1, 1).Value
        
        ' Check if this merged area spans only one column
        isSingleColumn = (mergeArea.Columns.Count = 1)
        
        ' Unmerge the cells first
        mergeArea.UnMerge
        
        ' Only fill the value across the area if it's a single-column merge
        If isSingleColumn Then
            mergeArea.Value = cellValue
        End If
        ' For multi-column merges: unmerging already leaves only the top-left cell with value, so we do nothing else
    Next mergeArea
    
    ' Restore normal Excel behavior
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    MsgBox "Unmerge and fill task completed!", vbInformation
End Sub

Key Details & How It Works #

• Target Worksheet: Swap ActiveSheet with Sheets("YourSheetName") if you want to target a specific sheet instead of the currently active one.
• Performance Boost: Disabling ScreenUpdating and EnableEvents makes the code run way faster, especially on large datasets—no more annoying cell flickering while it runs.
• Single-Column Check: The code checks if the merged area is only one column wide using mergeArea.Columns.Count = 1. Only then does it fill the value across all cells in the unmerged area.
• Cross-Column Handling: For merged areas that span multiple columns, unmerging them naturally leaves only the top-left cell with the original value. We leave those as-is, which matches your requirement of not filling cross-column values.

How to Use This Code #

1. Press Alt + F11 to open the VBA Editor.
2. Right-click your workbook in the Project Explorer > Insert > Module.
3. Paste the code into the new module.
4. Adjust the worksheet name if needed (as noted in the code comments).
5. Press F5 to run the macro, or assign it to a button in your worksheet for easier access.

内容的提问来源于stack exchange，提问作者Student of the Digital World