unMerge和填補空白VBA運行緩慢

我有一個Excel表，其中列「A」包含序列號。一個序列號可能會重複到幾行。列「A」中的單元格被合併[如果多於一行出現在一個序列號中]。我製作了以下宏來合併這些單元格，並在隨後的空白行中重複序列號，直到出現下一個序列號。我面臨的問題是這個宏運行速度很慢，例如對於包含30,000行的工作表，可能需要很長時間。有沒有一個整潔，不太慢的方法來做到這一點？unMerge和填補空白VBA運行緩慢

這是我使用的代碼。請指導。

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

問候

來源

2017-10-11 KhawarAmeerMalik

避免使用'.Select'和'.Activate'，因爲它們都導致事情運行速度非常緩慢，並且總是有更好的編寫代碼的方法。 – braX

@braX能否請您提出替代方案。 – KhawarAmeerMalik

只要你有一行以'.Select'結尾的代碼行，並且下一行是'Selection'，你就可以將它們結合起來......'Columns（「A：A」）.UnMerge'做同樣的事情。 – braX

這應該是最快的解決方案，沒有循環，簡單。

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

來源

2017-10-11 14:36:21

它使用一個數組所以它應該是相當快：

Option Explicit 

Public Sub UnmergeColA() 
    Dim ws As Worksheet, ur As Variant, r As Long 

    Set ws = Sheet1 'set a reference to working sheet by CodeName 

    ur = ws.UsedRange.Columns("A") 'get column A into Array 
    ws.UsedRange.Columns("A").unMerge 
    For r = 1 To UBound(ur) - 1 
     If Len(ur(r + 1, 1)) = 0 Then ur(r + 1, 1) = ur(r, 1) 
    Next 
    ws.UsedRange.Columns("A") = ur 'get updated Array back to the sheet 
End Sub

50萬行

This method (Array):  27.707 sec 
.FormulaR1C1 = "=r[-1]c": 77.867 sec

來源

2017-10-11 14:02:29

您的代碼顯示錯誤'1004'在以下行'ws.UsedRange.Columns（「A」）= ur'更新數組回到表單' – KhawarAmeerMalik

我試圖簡化你的代碼。我沒有在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

來源

2017-10-11 14:09:38 JonRo

您也可以關閉和打開屏幕更新，當您運行宏

在開始的時候您的代碼插入

application.screenupdating = false

並打開它在結束

application.screenupdating = true

來源

2017-10-11 14:27:30 KarmaWin

unMerge和填補空白VBA運行緩慢

回答

相關問題