Excel VBA 自动填充空白并合并相同值的解决方案

原创

洛秋_

发布于 2024-12-31 04:20:07

2450

文章被收录于专栏：洛秋的运维之路洛秋的运维之路

Excel VBA: 自动填充空白并合并相同值的解决方案

问题背景

在Excel中经常会遇到这样的数据处理需求：一列数据中存在多个空白单元格，需要用其上方最近的非空值填充，然后将相同的连续值合并成一个单元格。比如：

1
[空白]
[空白]
2
[空白]
[空白]
3

需要将其转换为三个合并的单元格，每个单元格分别包含1、2、3。

合并前

合并后

解决方案

我们可以通过VBA宏来自动化这个过程。下面是完整的解决方案：

1. VBA代码实现

Sub FillAndMergeCells()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim startCell As Range
    Dim lastRow As Long
    Dim currentValue As Variant
    
    'Set the active worksheet
    Set ws = ActiveSheet
    
    '获取最后一行
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    '设置要处理的范围
    Set rng = ws.Range("A1:A" & lastRow)
    
    '先填充空白单元格
    For Each cell In rng
        If IsEmpty(cell) Then
            cell.Value = cell.End(xlUp).Value
        End If
    Next cell
    
    '开始合并相同值的单元格
    Set startCell = rng.Cells(1)
    currentValue = startCell.Value
    
    Application.ScreenUpdating = False
    
    For Each cell In rng
        If cell.Row > 1 Then
            If cell.Value <> currentValue Then
                '如果值不同，合并之前的区域
                If startCell.Row <> cell.Row - 1 Then
                    Range(startCell, ws.Cells(cell.Row - 1, startCell.Column)).Merge
                End If
                Set startCell = cell
                currentValue = cell.Value
            ElseIf cell.Row = lastRow Then
                '如果是最后一行且值相同，合并到最后
                Range(startCell, cell).Merge
            End If
        End If
    Next cell
    
    '设置合并后的格式
    With rng
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    
    Application.ScreenUpdating = True
    
    MsgBox "合并完成！", vbInformation
End Sub

Sub AddMacroButton()
    '添加一个按钮来运行宏
    Dim btn As Button
    Set btn = ActiveSheet.Buttons.Add(100, 10, 120, 30)
    With btn
        .OnAction = "FillAndMergeCells"
        .Caption = "合并相同值"
    End With
End Sub