vba中快速删除多行

Sub zz()
    ar = Range("A1").CurrentRegion
    m = 1
    For i = 2 To UBound(ar)
        If ar(i, 1) <> "B" Then
            m = m + 1
            For j = 1 To 2
                ar(m, j) = ar(i, j)
            Next
        End If
    Next
    Range("A:B").ClearContents
    Range("A1").Resize(m, 2) = ar
End Sub