| |
こんななのかなあ？
Option Explicit
Public Sub RowsDelete()
Dim i As Long
Dim lngRows As Long
Dim lngCount As Long
Dim rngList As Range
Dim vntData As Variant
Dim strProm As String
' Application.ScreenUpdating = False
'データの左上隅を基準とする(列見出しが有る物とします）
Set rngList = ActiveSheet.Cells(1, "A")
With rngList
'データ行数を取得
lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row
If lngRows <= 1 And .Value = "" Then
strProm = "データが有りません"
GoTo Wayout
End If
'削除フラグの列をKeyとして整列
.Offset(1).Resize(lngRows, 2).Sort _
Key1:=.Offset(, 1), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlStroke
'B列データを配列に取得
vntData = .Offset(1, 1).Resize(lngRows).Value
End With
'データ行数分繰り返し
For i = 1 To lngRows
'FalseからTrueに変わる位置を取得
If vntData(i, 1) Then
lngCount = i
Exit For
End If
Next i
Erase vntData
With rngList
'行削除
.Offset(lngCount).Resize(lngRows - lngCount + 1).EntireRow.Delete
End With
strProm = "処理が完了しました"
Wayout:
Application.ScreenUpdating = True
Set rngList = Nothing
MsgBox strProm, vbInformation
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
