Question

我正在寻找有关快速删除三分之二中型数据集的见解。目前，我正在从文本文件中将空格分隔的数据导入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循环：

For i = 8 To n Step 3

使用Union创建存储在范围变量中的脱节范围。

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

然后立即删除所有内容。

rng.EntireRow.Delete

另一个鼓励的好习惯是使用总是声明任何范围对象的父级。随着您的代码变得越来越复杂，不会声明父母会导致问题。

使用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

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

2 个答案: