【VBA】複数の特定文字が入っていない行の削除

Question

実現したいこと

タイトルの通りではありますが、
エクセル表のなかで、複数の特定文字を絞り込み、特定文字が入っていない行のデータをクリアしたいです。

発生している問題・分からないこと

Sub 不要行の削除

Dim LastRow As Long
Dim i As Long
Dim i As Long
Dim Target As Variant

‘最終行取得
LastRow = Cells (Rows. Count, 1). End(x|Up). Row

'くだもの
Target =Array (”りんご，ふどう，もも”)

Application. DisplayAlerts = False
With ActiveSheet

’最終行から先頭へルーブ←
For i = LastRow To 12 Step -1

For i = 0 To UBound(Target)

‘くだものに該当しなければ行削除
If Instr(Cells(i, 2), Target (j)) = 0 Then
. Rows (i) .Delete
End If

Next j
Next
End With
Application. DisplayAlerts = True

End Sub

エクセル表(12行目から開始で参照はB列)
1lすいか
2lりんご
3lかき
4lぶどう
5lなし
6lいちご
7lもも

期待する実効値は
2lりんご
4lぶどう
7lもも

なのですが、全て削除されてしまいます。
おそらく複数の特定文字の指定で、
「りんご　かつ　ぶどう　かつ　もも」
というフィルターがかかってしまっているとは思うのですが、
「りんご　または　ぶどう　または　もも」
が入っている行以外の行を削除するフィルターにするにはどのような関数を使えばよろしいのかおしえていただきたいです！

該当のソースコード

特になし

試したこと・調べたこと

• teratailやGoogle等で検索した
• ソースコードを自分なりに変更した
• 知人に聞いた
• その他

上記の詳細・結果

teratailで同様の事案がないか確認したところ、見つかりませんでした。

補足

特になし

Comments

[tatsu99]

提示されたソースをこちらで実行するとコンパイルエラーになります。
手打ちでソースをアップするのはなく、あなたのPCのソースをそのままコピペしてください。
そうでないと、こちらで正しく再現できません。
ソースは、以下のようにしてアップしてください。
ソースのアップ方法
以下のようにすると、きちんとソースが表示されます。

</>をクリックします。
```ここに言語を入力
コード
```

と表示されるので
```①
②
```

①の箇所にVBAと入力し
②の箇所にソースをコピペして貼り付けます。

そうすると、きちんと表示されます。
質問は編集可能です。（ソースは再度アップ可能です）
上記のようにして、正しい方法でソースをアップし直してください。

[tatsu99]

If InStr(Cells(i, 2), Target(j)) = 0 Then
を
If InStr(Target(j), Cells(i, 2)) = 0 Then
に変えれば良いかと思います。

Answer 1

lastrow = Cells(Rows.Count, 1).End(xlUp).Row
Target = Array("りんご", "ぶどう", "もも")

For i = LastRow To 12 Step -1
' 見つかった時はループを途中で抜ける。3つとも見つからなかった時はループを最後まで行く
    For j = LBound(Target) To UBound(Target)
        If InStr(Cells(i, 2), Target(j)) > 0 Then Exit For
    Next j
    If j > UBound(Target) Then Rows(i).Delete
Next i

タイプミスだらけのコード掲載はやめましょう。
コードはコピペが原則ですが、「手元に紙しかない。Excelも無い」など、何らかの事情でコピペできない場合は、
「タイプミスが無いことに命賭けられる」と思えるまで確認してから投稿しましょう。

Answer 2

Target = Array ("りんご，ふどう，もも")

• 上記の Array 関数によって返されるのは（ "りんご", "ぶどう", "もも" の 3 つではなく）1 つの要素（ "りんご，ふどう，もも" という 1 つの文字列）を持つ 1 次元配列である。

If Instr(Cells(i, 2), Target (j)) = 0 Then
    .Row(i).Delete
End If

• アクティブシートの 2 列目に "りんご，ふどう，もも" という文字列と値が一致するセルは存在しないため、上記の Instr 関数の戻り値はどの行においても 0 となり、12 行目以降の全ての行は削除される。

• 仮に Target が "りんご", "ぶどう", "もも" の 3 つの要素を持つ 1 次元配列であったとしても、3 つの要素のうちどれか 1 つと一致しなかった時点で Delete メソッドを実行しており（「 3 つの要素のどれとも一致しなければ」という条件になっていない）、どの道全ての行が削除されることになる。

（修正例）

Sub 不要行の削除()

    Dim LastRow As Long
    Dim Target As Variant
    
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    'Array関数を使用する場合
    Target = Array("りんご", "ぶどう", "もも")
'    'Split関数を使用する場合
'    Target = Split("りんご,ぶどう,もも", ",", -1, vbBinaryCompare)
    
    Application.DisplayAlerts = False
    
    Dim i As Long
    Dim j As Long
    '一致フラグの宣言
    Dim IsMatch As Boolean
    
    With ActiveSheet
        For i = LastRow To 12 Step -1
            '一致フラグの初期化
            IsMatch = False
            For j = LBound(Target) To UBound(Target)
                'i 行目の 2 列目のセルの値に Target の j 番目の値が含まれている場合
                If InStr(Cells(i, 2), Target(j)) > 0 Then
                    '一致フラグを True にしてループを抜ける
                    IsMatch = True
                    Exit For
                End If
            Next j
            'Target のどの要素とも一致しなかった場合
            If IsMatch = False Then
                ' i 行目を削除
                .Rows(i).Delete
            End If
        Next i
    End With
    
    Application.DisplayAlerts = True

End Sub

Comments

[nasubikun2]

Array、Split両方で試しましたが、
Arrayでは全て消えてしまい、
Splitでは条件指定一つ目の行以外デリートされてしまいました（ ; ; ）

[sk.exe]

それは Target に配列を渡すところしか修正していない（上に、たぶん Array または Split 関数ヘの引数の渡し方も正しくない）からではないでしょうか。
プロシージャ全体のそれぞれのステートメントを再度読み直してください。