在excel中刪除單元格並根據值將內容向上移動

我有一些代碼工作來壓縮excel中的多個列，刪除任何空白單元格並向上分流數據。在excel中刪除單元格並根據值將內容向上移動

每個單元格都包含公式，我確實找到了一個代碼片斷，它允許我使用specialcells命令，但只刪除真正的空白單元格，而不是包含公式的單元格，其中結果會使單元格變爲空白。

這是我目前使用的，這是東西前一陣子我在此網站上發現編輯：

Sub condensey() 
Dim c As Range 
Dim SrchRng 

Set SrchRng = ActiveSheet.Range("B2", ActiveSheet.Range("B208").End(xlUp)) 
Do 
    Set c = SrchRng.Find("", LookIn:=xlValues) 
    If Not c Is Nothing Then c.Delete 
Loop While Not c Is Nothing 
End Sub

我試圖增加的工作表上的範圍，包括第二列，但是excel只是瘋了，假設它正在爲整個表中的每個單元格執行此操作。

然後我重複了這段代碼，我想壓縮每一列。

現在，這很棒，它完全符合我的要求，但速度很慢，尤其是當每列最多可容納200多行時。關於如何提高這個性能的任何想法，或者使用不同的方法重新編寫它？

來源

2014-01-22 GenericTechSupportAgent1

您是否已關閉screenupdating並將計算設置爲手動？ –

這跑< 1秒的300rows X 3cols

Sub DeleteIfEmpty(rng As Range) 
    Dim c As Range, del As Range 
    For Each c In rng.Cells 
     If Len(c.Value) = 0 Then 
      If del Is Nothing Then 
       Set del = c 
      Else 
       Set del = Application.Union(del, c) 
      End If 
     End If 
    Next c 
    If Not del Is Nothing Then del.Delete 
End Sub

來源

2014-01-22 18:11:50

這些答案太棒了，非常感謝！如果我有代表這樣做，會不高興！ – GenericTechSupportAgent1

+1你也可以試着用循環來做（參見[SO 15431801]（http://stackoverflow.com/questions/15431801/how-to-delete-multiple-rows-without-a-loop-in- excel-vba），但它可能不會更快 –

我發現，每列使用自動篩選比通過每個單元格範圍內的循環或「查找」荷蘭國際集團範圍內的每個空白單元格更快。使用下面的代碼和一些示例數據（3欄大約有300行空白和非空白單元格），在我的機器上花費了0.00063657天。使用循環遍歷每個單元格方法，耗時0.00092593天。我還在示例數據上運行了代碼，花了很多時間（我沒有讓它完成）。到目前爲止，下面的方法會產生最快的結果，但我想有人會找到更快的方法。

看來，刪除方法是最大的瓶頸。過濾非空白單元格並將它們粘貼到新範圍可能是最快的，然後在完成後刪除舊範圍。

Sub condensey2() 
Dim c As Range 
Dim tbl As Range, tblWithHeader As Range, tblEnd As Range, delRng As Range 
Dim i As Long 
Dim maxRows As Long 
Dim t As Double 

Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 

ActiveSheet.Calculate 

maxRows = ActiveSheet.Rows.Count 
ActiveSheet.AutoFilterMode = False 

With ActiveSheet 
    Set tblEnd = Range(.Cells(maxRows, 1), .Cells(maxRows, 3)).End(xlUp) 
    Set tbl = Range(.Cells(2, 1), Cells(tblEnd.Row, 3)) 
End With 

t = Now() 

Set tblWithHeader = tbl.Offset(-1).Resize(tbl.Rows.Count + 1) 

i = 1 
For i = 1 To tbl.Columns.Count 
    With tblWithHeader 
    .AutoFilter 
    .AutoFilter field:=i, Criteria1:="=" 
    End With 
    Set delRng = tbl.Columns(i).Cells.SpecialCells(xlCellTypeVisible) 
    ActiveSheet.AutoFilterMode = False 
    delRng.Delete xlShiftUp 

    'redefine the table to make it smaller to make the filtering efficient 
    With ActiveSheet 
    Set tblEnd = Range(.Cells(maxRows, 1), .Cells(maxRows, 3)).End(xlUp) 
    Set tbl = Range(.Cells(2, 1), Cells(tblEnd.Row, 3)) 
    End With 
    Set tblWithHeader = tbl.Offset(-1).Resize(tbl.Rows.Count + 1) 
Next i 

t = Now() - t 

Debug.Print Format(t, "0.00000000") 

Application.ScreenUpdating = True 
Application.Calculation = xlAutomatic 

End Sub

來源

2014-01-22 18:49:34

在excel中刪除單元格並根據值將內容向上移動

回答

相關問題