【VBA】高速！配列を使った条件に一致する行を削除

Sub DeleteRowsAndCopyRemainingToArray()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim lastCol As Long
    Dim i As Long, j As Long
    Dim conditionValue As String
    Dim dataArray() As Variant
    Dim remainingData() As Variant
    Dim dataCount As Long

    ' 対象のシートを指定
    Set ws = ThisWorkbook.Sheets("Sheet1")

    ' 削除条件の値を設定
    conditionValue = "削除対象" ' 例: "削除対象"という値を持つ行を削除

    ' 最終行と最終列を取得
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' A列の最終行を取得
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column ' 1行目の最終列を取得

    ' シートのデータを配列に読み込む
    dataArray = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol)).Value

    ' 配列の初期化（最大行数に合わせる）
    ReDim remainingData(1 To lastRow, 1 To lastCol) ' 残るデータを格納する配列

    ' 残るデータのカウント
    dataCount = 0

    ' 配列をループして条件を満たさない行を格納
    For i = 1 To lastRow
        If dataArray(i, 1) <> conditionValue Then ' 配列のA列の値が条件と一致しない場合
            dataCount = dataCount + 1
            For j = 1 To lastCol ' 列数分ループ
                remainingData(dataCount, j) = dataArray(i, j) ' 残るデータを配列に格納
            Next j
        End If
    Next i

    ' 配列のサイズを調整
    If dataCount > 0 Then
        ReDim Preserve remainingData(1 To dataCount, 1 To lastCol) ' 実際のデータ数に基づいて配列を再定義
    Else
        MsgBox "削除後のデータがありません。"
        Exit Sub
    End If

    ' 残ったデータを新しいシートに貼り付け（例: Sheet2に貼り付け）
    Dim targetWs As Worksheet
    Set targetWs = ThisWorkbook.Sheets("Sheet2")

    ' 配列のデータを貼り付け
    targetWs.Range("A1").Resize(UBound(remainingData, 1), UBound(remainingData, 2)).Value = remainingData

    MsgBox "データを貼り付けました。"
End Sub

If dataArray(i, 1) <> conditionValue Then ' 配列のA列の値が条件と一致しない場合