前の行の同じセルが同じ場合、Excelで行全体を削除する方法はありますか？

Question

私のExcelスプレッドシートには、11列と500k行が含まれています。各行は、8チャンネルデジタルロジックアナライザのサンプルです。列Aはタイムスタンプで、列B〜Iはビット値（各セルでは1または0のいずれか）です。列Jは、CONCATENATE（B、C、D、E、F、G、H、I）で作成されたバイナリのバイトです。 K列はBIN2HEX（J）で作成された16進数の同じバイトです。

ロジックアナライザは、データをかなりオーバーサンプリングしました。私は、バイト値が変更されていないサンプルを削除し、最初のサンプルのみを一連の連続した複製に保持したい。私は、セルK1を選択した後、次のコードを実行した場合、それは私が望むようオーバーサンプルを削除しますが、それ

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 

：これに

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 

：他の言葉で、私はこれを変更したいです非常にゆっくり実行されます。 （完了には数日かかります）

Sub DeleteOverSamples() 
    Do Until ActiveCell.Value = "" 
    If ActiveCell.Value = ActiveCell.Offset(-1, 0).Value Then 
     ActiveCell.EntireRow.Delete 
    ElseIf ActiveCell.Value <> ActiveCell.Offset(-1, 0).Value Then 
     ActiveCell.Offset(1, 0).Select 
    End If 
    Loop 
End Sub 

これをより効率的にするにはどうすればよいですか？ EntireRow.Deleteが時間のかかる関数である場合、一度に削除する複数の行を選択できますか（何百というサンプルに対して繰り返し値が繰り返されることがあります）。どうもありがとう！

Answer 1

削除方法が遅く、セルの値の入出力も遅いです。 Variantアレイの使用は高速です。

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 

Answer 2

次のコードでは、最初のシートから関連する値をコピーし、新しいシートを作成します。あなたが最初の数行のために提供されたデータを使用して、私はこれをテストし

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 

、その後のためにあなたの最後の行を複製します次の499995行（ただし、B列は0または1の間でランダムに選択されます）、約250,000行のデータをコピーするには20秒をわずかに上回りました。列Bにランダムな効果がなければ、期待していた3行をコピーするのにわずか19秒を要しました。列Bの代わりに列Iのランダムな効果がわずか28秒を要しました。これはおそらく最も遅いでしょう。

（計算された列JまたはKを使用すると、現在見ている8つのセルの代わりに1つのセルを調べるだけで済みますが、実際にそれらの列が必要か、既存のコードを簡単にするために追加しただけなのか）。