使用VBA删除每个第2和第3行

我正在寻找快速移除中等大小数据集的三分之二的见解。 目前，我正在从文本文件导入空格分隔的数据到Excel中，我正在使用一个循环来逐行删除数据。 循环从最底行的数据开始，并删除上行。 数据按时间顺序排列，我不能简单地砍掉数据的第一个或最后三分之二。 基本上，数据正在被过采样，太多的数据点彼此靠得太近。 这是一个艰苦的过程，我只是在寻找另一种方法。

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 

Answer 1

使用一个循环，允许一定数量的步进：

For i = 8 To n Step 3

使用Union创build存储在范围variables中的不连续范围。

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 

Answer 2

您可以使用数组并将三分之一的行写入新数组。 清除原稿后打印出来。

如果有的话，你会失去公式。 如果你只有一个基本的数据集，这可能适合你。 它应该是快速的

 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