使用VBA刪除每個第2和第3行

我在尋找有關快速刪除中等大小數據集的三分之二的見解。目前，我正在將空格分隔的數據從文本文件導入到Excel中，並且我正在使用循環逐行刪除數據。循環從數據的最底行開始，並刪除上行。數據按時間順序排列，我不能簡單地砍掉數據的前三分之二或三分之二。基本上，發生的情況是數據被過度採樣，太多的數據點彼此靠得太近。這是一個非常緩慢的過程，我只是在尋找另一種方法。使用VBA刪除每個第2和第3行

Sub Delete() 

Dim n As Long 

n = Application.WorksheetFunction.Count(Range("A:A")) 

Application.Calculation = xlCalculationManual 

Do While n > 5 

n = n - 1 
Rows(n).Delete 
n = n - 1 
Rows(n).Delete 
n = n - 1 

Loop 

    Application.Calculation = xlCalculationAutomatic 

End Sub

來源

2017-09-05 Jesse

另外，我看着多選擇所有感興趣的行中循環，執行與一行代碼中刪除所有行的選擇後，卻無法弄清楚一種做法。我會認爲這可能會增加整體計算時間。 – Jesse

for循環使用，通過一定數目的允許步進：

For i = 8 To n Step 3

使用聯盟創建存儲在一個範圍內變化脫節的範圍。

Set rng = Union(rng, .Range(.Cells(i + 1, 1), .Cells(i + 2, 1)))

然後一次全部刪除。

rng.EntireRow.Delete

另一個好習慣，鼓勵是宣佈任何範圍對象的父使用ALWAYS。隨着你的代碼變得越來越複雜，沒有宣佈父母會導致問題。

通過使用With塊。

With Worksheets("Sheet1")

，我們可以先全部範圍對象與.表示鏈接到該父。

Set rng = .Range("A6:A7")

Sub Delete() 

Dim n As Long 
Dim i As Long 
Dim rng As Range 

Application.Calculation = xlCalculationManual 

With Worksheets("Sheet1") 'change to your sheet 
    n = Application.WorksheetFunction.Count(.Range("A:A")) 

    Set rng = .Range("A6:A7") 

    For i = 8 To n Step 3 
     Set rng = Union(rng, .Range(.Cells(i + 1, 1), .Cells(i + 2, 1))) 
    Next i 
End With 

rng.EntireRow.Delete 

Application.Calculation = xlCalculationAutomatic  


End Sub

來源

2017-09-05 22:50:05

謝謝，明天我會試試這個。你期望使用這種方法看到計算時間大大減少嗎？ – Jesse

@Jesse是的，因爲它只做刪除一次。 –

我使用小數據集將您的方法與原始方法進行了比較，速度大約快225％。使用相同的數據集，循環需要執行519s和231s。這兩套代碼都包含在一個.xlsm中，其中包含很多其他工作表，模塊等。然後我把我的原始代碼插入到一個空的.xlsm中，並再次計時，並執行了71s。我假設你的方法在一個空的.xlsm中需要30秒。所以我的下一個問題：是否有任何其他屬性，我可以在循環中禁用，以加快速度？ – Jesse

你可以使用數組和寫出來的行的三分之一到一個新的數組。然後在清除原稿後打印出來。

如果有的話，你會失去公式。如果你只有一個基本數據集，這可能適合你。它應該是快

Sub MyDelete() 
    Dim r As Range 
    Set r = Sheet1.Range("A1").CurrentRegion 'perhaps define better 
    Set r = r.Offset(1, 0).Resize(r.Rows.Count - 1) ' I assume row 1 is header row. 

Application.ScreenUpdating = False 

    Dim arr As Variant 
    arr = r.Value 

    Dim newArr() As Variant 
    ReDim newArr(1 To UBound(arr), 1 To UBound(arr, 2)) 
    Dim i As Long, j As Long, newCounter As Long 
    i = 1 
    newCounter = 1 

    Do 
     For j = 1 To UBound(arr, 2) 
      newArr(newCounter, j) = arr(i, j) 
     Next j 

     newCounter = newCounter + 1 
     i = i + 3 
    Loop While i <= UBound(arr) 

    r.ClearContents 
    Sheet1.Range("A2").Resize(newCounter - 1, UBound(arr, 2)).Value = newArr 

Application.ScreenUpdating = True 

End Sub

來源

2017-09-06 00:05:57 MacroMarc

使用VBA刪除每個第2和第3行

回答

相關問題