エクセルマクロ 特定の文字列を含む行のみを残す （マクロ修正）

以下のマクロは、EXCEL２００３で
「特定の文字列が含まれている列を削除する」動作をするマクロです

Sub Macro1()
Const col As String = "A"　'文字列が入力されている列
Dim idx As Long
Dim keyWord
keyWord = Application.InputBox("削除対象の文字列は？", Type:=2)
If TypeName(keyWord) <> "Boolean" And Len(keyWord) > 0 Then
　　For idx = Cells(65536, col).End(xlUp).Row To 1 Step -1
　　　　If InStr(Cells(idx, col).Value, keyWord) > 0 Then
'　　　　If Application.CountIf(Rows(idx), "*" & keyWord & "*") > 0 Then
　　　　　　Rows(idx).Delete
　　　　End If
　　Next idx
End If
End Sub

このマクロを、
「特定の文字列が含まれている行のみを残し、それ以外を削除する」
というマクロに変更したいと思っています。
是非ご回答お願いいたします。

No.1 回答者： fujillin 回答日時： 2009/09/09 10:15

＞If InStr(Cells(idx, col).Value, keyWord) > 0 Then

の部分が条件の判定をしているところですので、これを逆にすれば、実行内容（削除する対象）も逆になります。

この回答へのお礼

お礼遅くなりました。

逆にするだけでは駄目でしたが、
この部分をよく考えたら自力でできました。
ありがとうございます！

お礼日時：2009/09/28 15:55

No.2 ベストアンサー 回答者： Wendy02 回答日時： 2009/09/09 12:13

こんにちは。

ご自身のコードではありませんね。ある程度、コードが書ける人のものです。間違いがありますが。

私としては、他人のコードはあまりいじらないようにしていますので、二番目に私のコードを出しておきます。
'-------------------------------------------
Sub Macro1R()
Const col As String = "A"　'文字列が入力されている列
Dim idx As Long
Dim keyWord　'←Variant にしていから、本来は、TypeName では受けない
keyWord = Application.InputBox("除外対象の文字列は？", Type:=2)
If TypeName(keyWord) <> "False" And Len(keyWord) > 0 Then
　　For idx = Cells(65536, col).End(xlUp).Row To 1 Step -1
　　　　If InStr(Cells(idx, col).Value, keyWord) = 0 Then
　　　　If Application.CountIf(Rows(idx), "*" & keyWord & "*") = 0 Then
　　　　　　Rows(idx).Delete
　　　　End If
　　　　End If
　　Next idx
End If
End Sub
'-------------------------------------------
'-------------------------------------------
Sub MacroTest1()
　　Dim keyWord As Variant
　　Dim FirstAdd As String
　　Dim UR As Range
　　Dim c As Range
　　Const col As Long = 1 '列数
　　keyWord = Application.InputBox("除外対象の文字列は？", Type:=2)
　　If VarType(keyWord) = vbBoolean Or Len(keyWord) = 0 Then Exit Sub
　　
　　With ActiveSheet
　　　　With .UsedRange
　　　　　　Set c = .Find( _
　　　　　　What:="*" & keyWord & "*", _
　　　　　　LookIn:=xlValues, _
　　　　　　LookAt:=xlPart, _
　　　　　　SearchOrder:=xlByRows)
　　　　　　
　　　　　　If Not c Is Nothing Then
　　　　　　　　FirstAdd = c.Address
　　　　　　　　Set UR = c
　　　　　　　　Do
　　　　　　　　　　Set c = .FindNext(c)
　　　　　　　　　　Set UR = Union(UR, c)
　　　　　　　　　　If c.Address = FirstAdd Then Exit Do
　　　　　　　　Loop Until c Is Nothing
　　　　　　End If
　　　　End With
　　　　If Not UR Is Nothing Then
　　　　　　UR.EntireRow.Hidden = True
　　　　　　.UsedRange.SpecialCells(xlCellTypeVisible).Delete
　　　　　　.UsedRange.EntireRow.Hidden = False
　　　　End If
　　End With
End Sub
　　

この回答へのお礼

お礼遅くなりました。
大変丁寧にご回答ありがとうございます！

お礼日時：2009/09/28 15:54