Excel多命令按钮场景下撤销按钮失效及一键合并单元格问题咨询

项目基础说明 #

现有Excel数据迁移项目结构如下：

• Sheet1用于存放空白基础表格
• Sheet2放置20余个命令按钮，每个按钮分别绑定一个待迁移数据工作表，点击后将对应工作表数据迁移至Sheet1表格中，要求所有功能可独立运行
• 现有插入行功能代码（匹配第一列数值插入对应行到Sheet1）：

Private Sub CommandButton1_Click()
Dim lastrowOS, lastrowPrekovremeno As Long
Dim skip As Boolean
Dim list As New Collection

lastrowOS = Sheets("OS").Cells(Rows.Count, 1).End(xlUp).Row
lastrowPrekovremeno = Sheets("Prekovremeno").Cells(Rows.Count, 1).End(xlUp).Row

Sheets("OS").Cells(1, 13).Value = lastrowPrekovremeno

For i = lastrowOS To 3 Step -1
    skip = False
    For k = 1 To list.Count
        If list(k) = Sheets("OS").Cells(i, 1).Value Then
            skip = True
        End If
    Next k
    If Not skip Then
        For j = lastrowPrekovremeno To 3 Step -1
            If Sheets("Prekovremeno").Cells(j, 1).Value = Sheets("OS").Cells(i, 1).Value Then
                list.Add (Sheets("OS").Cells(i, 1).Value)
                Sheets("Prekovremeno").Cells(j, 1).EntireRow.Copy
                Sheets("OS").Cells(i + 1, 1).Insert Shift:=xlDown
            End If
        Next j
    End If
Next i

End Sub

问题1：撤销按钮无法运行修复 #

问题原因 #

现有撤销逻辑基于类模块实现，存在三个缺失点：

1. 没有实现clsUndoObject类的核心方法ExecuteCommand（记录操作前原始值）和UndoChange（恢复原始值）
2. 数据迁移代码中没有调用AddAndProcessObject方法记录操作到撤销队列
3. 撤销按钮的点击事件CommandButton2_Click为空，没有绑定撤销逻辑

修复步骤 #

1. 首先在VBA编辑器中插入类模块，命名为clsUndoObject，添加以下代码：

Private m_oObj As Object
Private m_sProp As String
Private m_vOldVal As Variant
Private m_vNewVal As Variant

Public Property Let ObjectToChange(o As Object)
    Set m_oObj = o
End Property
Public Property Get ObjectToChange() As Object
    Set ObjectToChange = m_oObj
End Property

Public Property Let PropertyToChange(s As String)
    m_sProp = s
End Property
Public Property Get PropertyToChange() As String
    PropertyToChange = m_sProp
End Property

Public Property Let NewValue(v As Variant)
    m_vNewVal = v
End Property
Public Property Get NewValue() As Variant
    NewValue = m_vNewVal
End Property

Public Function ExecuteCommand() As Boolean
    ' 执行操作前先记录旧值
    m_vOldVal = CallByName(m_oObj, m_sProp, VbGet)
    CallByName m_oObj, m_sProp, VbLet, m_vNewVal
    ExecuteCommand = True
End Function

Public Sub UndoChange()
    ' 撤销时恢复旧值
    CallByName m_oObj, m_sProp, VbLet, m_vOldVal
End Sub

2. 在数据迁移的插入行代码中，每次插入行前记录对应操作到撤销队列
3. 填充撤销按钮点击事件代码：

Private Sub CommandButton2_Click()
    ' 撤销最近一次操作，需要撤销所有操作则替换为UndoAll
    UndoLast
End Sub

问题2：合并单元格弹窗消除&一键合并实现 #

问题原因 #

合并多值单元格时Excel默认弹出确认提示，是因为系统默认会提醒仅保留左上角单元格数值，关闭系统提示即可消除弹窗，同时可优化原有代码逻辑实现一键完成所有合并操作。

优化后代码 #

Private Sub CommandButton1_Click()
    Dim lastrowOS As Long, startRow As Long, i As Long
    ' 关闭系统提示和屏幕更新，消除弹窗同时提升运行效率
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    lastrowOS = Cells(Rows.Count, 1).End(xlUp).Row
    startRow = 3 ' 第一列数据起始行，可根据实际情况调整
    
    For i = startRow To lastrowOS
        ' 定位连续相同值的最后一行
        If i = lastrowOS Or Cells(i, 1).Value <> Cells(i + 1, 1).Value Then
            Range(Cells(startRow, 1), Cells(i, 1)).Merge
            startRow = i + 1
        End If
    Next i
    
    ' 恢复系统默认设置
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

优化后的代码无需点击确认，点击一次按钮即可自动完成第一列所有相同值单元格的合并，同时简化了循环逻辑，运行效率更高。

内容的提问来源于stack exchange，提问作者Bojan M