Question

我有一张Excel表格，其中列＆＃34; A＆＃34;包含序列号。一个序列号可能会重复几行。列中的单元格＆＃34; A＆＃34;合并[如果一个序列号出现多个行]。我已经使用以下宏来UN合并这些单元格并在后续空白行中重复序列号，直到出现下一个序列号。我面临的问题是这个宏运行速度很慢，例如对于包含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

unMerge和填补空白VBA运行缓慢

3 个答案: