| 
    
     |  | ▼MAX さん: 
 先日はあわてて不正確なものをアップして申し訳ありませんでした。
 すでに解決しておられるとは思いますが、抽出結果の削除の1つの例として。
 
 Sub 削除実行()
 Dim rr As Range
 
 If LineCount = 0 Then
 MsgBox "削除すべき抽出結果がありません"
 Exit Sub
 End If
 
 Set rr = Range("A1").CurrentRegion
 rr.Offset(1, 0).Resize(rr.Rows.Count - 1, rr.Columns.Count).EntireRow.Delete
 
 End Sub
 
 Function LineCount() As Long
 Dim rr As Range
 Dim x As Long
 Dim myArea As Range
 Dim ans As Long
 
 Set rr = ActiveSheet.AutoFilter.Range
 Set rr = Intersect(rr, rr.Offset(1))
 
 If rr Is Nothing Then Exit Function
 
 Set rr = rr.Columns(1)
 On Error GoTo bye
 Set rr = rr.SpecialCells(xlCellTypeVisible)
 
 For Each myArea In rr.Areas
 ans = ans + myArea.Rows.Count
 Next
 
 LineCount = ans
 bye:
 End Function
 
 
 |  |