在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中删除单元格并根据值将内容向上移动

回答

相关问题