如果前一行中的同一单元格相同，如何删除Excel中的整行？

我的excel电子表格包含11列和500k行。每行是8通道数字逻辑分析仪的样本：a列是时间戳；B列到I列是位值（每个单元格中为1或0）；列J是用连接（B、C、D、E、F、G、H、I）创建的二进制字节；列K是用BIN2HEX（J）创建的十六进制字节

逻辑分析仪对数据进行了大量的过采样。我想删除字节值没有改变的样本，只保留一系列连续副本中的第一个样本。换句话说，我想改变这一点：

A        B  C  D  E  F  G  H  I  J         K
0.67497  1  0  0  1  1  1  1  0  10011110  9E
0.67498  1  0  0  1  1  1  0  1  10011101  9D
0.67499  1  0  0  1  1  1  0  1  10011101  9D
0.67500  1  0  0  1  1  1  0  1  10011101  9D
0.67501  1  0  0  1  1  1  1  0  10011110  9E

为此：

A        B  C  D  E  F  G  H  I  J         K
0.67497  1  0  0  1  1  1  1  0  10011110  9E
0.67498  1  0  0  1  1  1  0  1  10011101  9D
0.67501  1  0  0  1  1  1  1  0  10011110  9E

如果我在选择单元格K1后运行以下代码，它会根据我的需要删除过多的样本，但运行速度非常慢。（需要几天才能完成。）

子删除过采样（）
直到ActiveCell.Value=“”
如果ActiveCell.Value=ActiveCell.Offset（-1，0）.Value，则
ActiveCell.EntireRow.Delete
ElseIf-ActiveCell.Value-ActiveCell.Offset（-1，0）.Value-Then
ActiveCell.Offset（1，0）。选择
如果结束
环
端接头

---

我怎样才能提高效率？如果EntireRow.Delete是一个耗时的函数，我是否可以一次选择多行进行删除（有时重复值会重复数百个样本）？非常感谢

以下代码将创建一个新图纸，从第一张图纸复制相关值：

Sub test()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim ws0 As Worksheet
    Dim ws1 As Worksheet
    Dim r0 As Long
    Dim r1 As Long
    Dim c As Long
    Dim startTime As Single
    startTime = Timer

    Set ws0 = ActiveSheet
    Set ws1 = Worksheets.Add
    r0 = 1
    r1 = 1
    Do While Not IsEmpty(ws0.Cells(r0, 1).Value)
        If r0 = 1 Then
            ws1.Rows(r1).Range("A1:I1").Value = ws0.Rows(r0).Range("A1:I1").Value
            r1 = r1 + 1
        Else
            For c = 2 To 9
                If ws0.Cells(r0, c).Value <> ws0.Cells(r0 - 1, c).Value Then
                    ws1.Rows(r1).Range("A1:I1").Value = ws0.Rows(r0).Range("A1:I1").Value
                    r1 = r1 + 1
                End If
                Exit For
            Next
        End If
        r0 = r0 + 1
    Loop

    MsgBox "Finished in " & (Timer - startTime) & " seconds"
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

子测试（）
Application.ScreenUpdating=False
Application.Calculation=xlCalculationManual
将ws0设置为工作表
将ws1设置为工作表
变暗r0等于长
变暗r1为长
尺寸c与长度相同
暗淡的开始时间如同单身
开始时间=计时器
设置ws0=ActiveSheet
设置ws1=工作表。添加
r0=1
r1=1
不为空时执行（ws0.Cells（r0，1.Value）
如果r0=1，则
ws1.Rows（r1）.Range（“A1:I1”）.Value=ws0.Rows（r0）.Range（“A1:I1”）.Value
r1=r1+1
其他的
对于c=2到9
如果ws0.Cells（r0，c）.Value为ws0.Cells（r0-1，c）.Value，则
ws1.Rows（r1）.Range（“A1:I1”）.Value=ws0.Rows（r0）.Range（“A1:I1”）.Value
r1=r1+1
如果结束
退出
下一个
如果结束
r0=r0+1
环
MsgBox“完成时间”（计时器-开始时间）和“秒”
Application.Calculation=xlCalculationAutomatic
Application.ScreenUpdating=True
端接头

我使用您为前几行提供的数据对此进行了测试，然后为接下来的499995行复制了最后一行（除了在

0

或

1

之间随机选择B列），复制大约250000行数据花费了略多于20秒的时间。如果没有B列中的随机效应，复制您期望的3行只需19秒多。第一列中的随机效果，而不是第二列，只花了28秒多——这可能是最慢的

---

（如果它使用计算出的列J或K，速度会更快，因为它每行只需要查看一个单元格，而不是当前查看的8个单元格，但我不确定您是否确实需要这些列，或者您是否只是为了简化现有代码而添加这些列。）

以下代码将创建一个新的工作表，从第一页复制相关值：

Sub test()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim ws0 As Worksheet
    Dim ws1 As Worksheet
    Dim r0 As Long
    Dim r1 As Long
    Dim c As Long
    Dim startTime As Single
    startTime = Timer

    Set ws0 = ActiveSheet
    Set ws1 = Worksheets.Add
    r0 = 1
    r1 = 1
    Do While Not IsEmpty(ws0.Cells(r0, 1).Value)
        If r0 = 1 Then
            ws1.Rows(r1).Range("A1:I1").Value = ws0.Rows(r0).Range("A1:I1").Value
            r1 = r1 + 1
        Else
            For c = 2 To 9
                If ws0.Cells(r0, c).Value <> ws0.Cells(r0 - 1, c).Value Then
                    ws1.Rows(r1).Range("A1:I1").Value = ws0.Rows(r0).Range("A1:I1").Value
                    r1 = r1 + 1
                End If
                Exit For
            Next
        End If
        r0 = r0 + 1
    Loop

    MsgBox "Finished in " & (Timer - startTime) & " seconds"
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

子测试（）
Application.ScreenUpdating=False
Application.Calculation=xlCalculationManual
将ws0设置为工作表
将ws1设置为工作表
变暗r0等于长
变暗r1为长
尺寸c与长度相同
暗淡的开始时间如同单身
开始时间=计时器
设置ws0=ActiveSheet
设置ws1=工作表。添加
r0=1
r1=1
不为空时执行（ws0.Cells（r0，1.Value）
如果r0=1，则
ws1.Rows（r1）.Range（“A1:I1”）.Value=ws0.Rows（r0）.Range（“A1:I1”）.Value
r1=r1+1
其他的
对于c=2到9
如果ws0.Cells（r0，c）.Value为ws0.Cells（r0-1，c）.Value，则
ws1.Rows（r1）.Range（“A1:I1”）.Value=ws0.Rows（r0）.Range（“A1:I1”）.Value
r1=r1+1
如果结束
退出
下一个
如果结束
r0=r0+1
环
MsgBox“完成时间”（计时器-开始时间）和“秒”
Application.Calculation=xlCalculationAutomatic
Application.ScreenUpdating=True
端接头

我使用您为前几行提供的数据对此进行了测试，然后为接下来的499995行复制了最后一行（除了在

0

或

1

之间随机选择B列），复制大约250000行数据花费了略多于20秒的时间。如果没有B列中的随机效应，复制您期望的3行只需19秒多。第一列中的随机效果，而不是第二列，只花了28秒多——这可能是最慢的

---

（如果它利用计算出的列J或K，速度会更快，因为它只需要每行查看一个单元格，而不是当前查看的8个单元格，但我不确定您是否真的需要这些列，或者您是否只是为了简化现有代码而添加这些列。）

删除方法很慢，而且单个单元格值的输入/输出也很慢。 使用

变量

数组速度很快

Sub test()
    Dim vDB As Variant, vR() As Variant
    Dim r As Long, c As Integer, n As Long, j As Integer
    Dim s As String

    vDB = Range("a1").CurrentRegion
    r = UBound(vDB, 1)
    c = UBound(vDB, 2)

    s = vDB(1, 11)

    n = n + 1
    ReDim Preserve vR(1 To r, 1 To c)
    For j = 1 To c
        vR(n, j) = vDB(1, j)
    Next j

    For i = 1 To r
        If s <> vDB(i, 11) Then
            n = n + 1
            For j = 1 To c
                vR(n, j) = vDB(i, j)
            Next j
            s = vDB(i, 11)
        End If
    Next i
    Sheets.Add
    Range("a1").Resize(n, c) = vR

End Sub

子测试（）
Dim vDB作为变型，vR（）作为变型
Dim r为长，c为整数，n为长，j为整数
像线一样变暗
vDB=范围（“a1”）。当前区域
r=UBound（vDB，1）
c=UBound（vDB，2）
s=vDB（1，11）
n=n+1
重拨保留vR（1对r，1对c）
对于j=1到c
vR（n，j）=vDB（1，j）
下一个j
对于i=1到r
如果s vDB（i，11），则
n=n+1
对于j=1到c
vR（n，j）=vDB（i，j）
下一个j
s=vDB（i，11）
如果结束