取消合并并填补空白 VBA 运行缓慢

Question

我有一个Excel工作表，其中"A"列包含序列号。一个序列号可以重复到几行。合并"A"列中的单元格 [如果一个序列号显示多行]。我已经制作了以下宏来取消合并这些单元格，并在随后的空白行中重复序列号，直到出现下一个序列号。我面临的问题是这个宏运行得非常慢，例如，对于包含 30,000 行的工作表，可能需要很长时间。有没有一种整洁且速度较慢的方法？

这是我正在使用的代码。请指导。

Sub Unmerge_Cell()
Dim NumRows As Integer
Range("B2").Select
NumRows = Range("B2", Range("B2").End(xlDown)).Rows.Count
    Columns("A:A").Select
    Selection.UnMerge
    Range("A2").Select
    Range("A2").Activate
    For i = 1 To NumRows - 1           
        If IsEmpty(ActiveCell.Offset(1, 0).Value) = True Then
            ActiveCell.Select
     Selection.Copy
            ActiveCell.Offset(1, 0).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        Else
         ActiveCell.Offset(1, 0).Select
         ActiveCell.Offset(0, 0).Activate
        End If    
    Next
Range("A1").Select
End Sub

问候

Answer 1

这应该是最快的解决方案，没有循环，简单。

Sub unMerge()
    Dim lastRow As Long
    lastRow = Range("B2").End(xlDown).Row
    Range("A:A").unMerge
    Range("A2:A" & lastRow).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=r[-1]c"
    With Range("A2:A" & lastRow)
        .Value = .Value  'convert formula to constant
    End With
End Sub

Answer 2

我

试图简单地编写你的代码。 我还没有在Excel中测试过它;-/

Sub Unmerge_Cell()
Dim NumRows As Integer
Dim i as Long
    NumRows = Range("B2", Range("B2").End(xlDown)).Rows.Count
    For i = 1 To NumRows - 1  
        If IsEmpty(Range("A2").Offset(i,0).Value) Then
            Range("A2").Offset(i,0).Value = Range("A2").Offset(i-1,0).Value
        End If
    Next
End Sub

Answer 3

您还可以在宏运行时关闭和打开屏幕更新

在代码插入的开头

application.screenupdating = false

并在最后打开它

application.screenupdating = true