用VBA删除excel中的每n行答案

【问题标题】：delete every n rows in excel with VBA用VBA删除excel中的每n行
【发布时间】：2022-03-02 05:31:04
【问题描述】：

我在 excel 中有一个数据集，每 15 分钟进行一次测量（一行测量一次），我想只保留整整一小时的数据并删除其余数据。换句话说：我想保留第一行，删除接下来的三行，保留第 5 行，删除接下来的三行，依此类推。我想使用 VBA，但我对此完全陌生。我在这里找到了这个宏，它每四行删除一次

Sub remove_rows()
Dim x As Long
Application.ScreenUpdating = False

For x = 100 To 1 Step -5
    Range(x & ":" & x - 3).EntireRow.Delete
Next x

Application.ScreenUpdating = True
End Sub

（来源：Delete every four rows in excel）如何将其更改为仅每三行删除一次？我必须对每 5 分钟进行一次测量的数据集执行相同的操作（保留 1 行，删除接下来的 11 行，保留第 12 行，依此类推）。这个宏对这个数据集也有好处吗？最后 - 使用 VBA 是解决这个问题的最佳方法还是有另一种更好的方法？数据集相当大（100k+ 行）。

【问题讨论】：

标签： excel vba powerquery

【解决方案1】：

Powerquery（2016 年在数据选项卡 > 获取和转换，2013 年 Microsoft 的免费插件，然后是 powerquery 选项卡）绝对针对此类操作进行了优化你提到的行数。编写查询需要

.66 of a second on a test with 200K rows to complete task.

1) 在数据中选择行，然后从表中选择数据>

2) 表明你的表格是否有标题

3) 查询编辑器屏幕弹出

4) 选择主页 > 删除行 > 删除备用行

5) 指定模式。例如，保持 1 remove 3 如您的示例所示：

6) 点击确定。观察新模式是否符合要求

7) 主页 > 关闭并加载 >

8) 指定关闭和加载的位置，例如新工作表

您可以加载到同一工作表或新工作表。宾果游戏你有你的新数据集。每当您向原始数据集添加行时，您只需刷新此查询，结果集就会更新，删除不需要的行。

输出：

刷新查询（绿色圆圈箭头）：

1) 工作簿查询本身旁边

2) 或从功能区 > 刷新

【讨论】：

【解决方案2】：

我认为上面的代码有点危险，需要针对不同的总行数进行调整。你可以修改如下：

For x = 100 To 1 Step -4
    Range(x & ":" & x - 2).EntireRow.Delete
Next x

但您必须确保从正确的位置开始并保留正确的单元格。 Step -4 一次后退四个单元格，然后下一行删除行 x、x-1 和 x-2。

为什么不直接创建一个列来指示观察是否在一小时后结束，然后按该列对列表进行排序并删除转换点之后的所有内容？它的自动化程度较低，但也不太可能导致问题。

如果你真的想走 VBA 路线，我会检查代码以确保观察是每小时一次，然后才删除。不过，我不太愿意相信我的数据。

【讨论】：

【解决方案3】：

下面的第一个版本 (AutoFilter) 非常快 - 2 秒，100 K 行

要更改行间隔，请更新Const FRM（公式）中的4

版本 1 - 使用 AuroFilter

Option Explicit

'Deleted Rows: 75,000 (out of 100,000) - Time:  2.341 sec

Public Sub DeleteRowSetsAutoFilter()

    Const FRM = "=MOD(ROW() - 1, 4) = 0"        'Rows where reminder of Row/4 = 0

    Dim ws1 As Worksheet, ws2 As Worksheet, wsName As String, fc As Range

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set ws1 = ActiveSheet
    Set ws2 = Sheets.Add(After:=ws1)            'Add new sheet
    wsName = ws1.Name

    Set fc = ws1.UsedRange.Columns(ws1.UsedRange.Columns.Count + 1) 'Filter column
    fc.Formula = FRM
    fc.AutoFilter Field:=1, Criteria1:="TRUE"   'Rows to be deleted: 2 To 4, 6 To 8, ...

    ws1.UsedRange.Copy                          'Copy visible rows to new sheet
    ws2.Cells.PasteSpecial xlPasteColumnWidths
    ws2.Cells.PasteSpecial xlPasteAll           'Paste data on new sheet

    ws1.Delete                                  'Delete old sheet
    ws2.Name = wsName
    ws2.Cells(1).Select
    ws2.Columns(ws2.UsedRange.Columns.Count).EntireColumn.Delete  'Delete filter column

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.CutCopyMode = False
End Sub

版本 2 - 使用 For 循环

Public Sub DeleteRowSetsForLoop()

    Const STP = 4    'Row interval

    Dim ws As Worksheet, lr As Long, i As Long, toDel As Range

    Set ws = ActiveSheet
    lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    Set toDel = ws.Rows(lr + 1) 'First empty row (just to set the range)

    For i = 1 To lr Step STP
        Set toDel = Union(toDel, ws.Rows(i + 1 & ":" & i + (STP - 1))) '2-4, 6-8, etc.
    Next

    toDel.EntireRow.Delete
End Sub

Rows: 2,500  (out of 10 K)

DeleteRowSetsAutoFilter() - Time: 0.085 sec, 0.086 sec, 0.089 sec
DeleteRowSetsForLoop()    - Time: 9.568 sec, 9.524 sec, 9.530 sec

【讨论】：