NGワードが何個含まれているかチェックしたいです

はじめまして。
VBAはいろいろなサイトからのコピペでつなぎ合わせて使っている初心者です。
不足している情報等ございましたら教えてください。
よろしくお願いいたします。

前提・実現したいこと

Excelのlistシートに載っている文字がアクティブ列の文章にいくつ含まれているかチェックしたいです。
（文章中にNGワードが何個含まれているかチェックしたいです。）

期待する結果
アクティブシートの対象文章が入っているセルの隣のセルに数字（NGワードが含まれている数）が表示される

listシート
A列：NGワードの一覧

アクティブシート
列、シート名共に変動する可能性があるので固定にしたくないです。

発生している問題・エラーメッセージ

・ループしないです
・いくつ含まれているかをどうやって入れたらいいかわからないです
※↓いろんなサイトからのコピペでひとまず1つのセルの隣に○を表示させられたのですが
ここからどうしたらいいのか、、

Sub リストによる検索()
    Dim i As Long
    Dim lastRow As Long
    Dim A As Long
    
     Dim wS1 As Worksheet
     Dim wS2 As Worksheet
     Dim Str1 As String, Str2 As String
    
    Set wS1 = ActiveSheet
    Set wS2 = Worksheets("list")

  
    
    A = ActiveCell.Column 'アクティブなセルの列番号を取得＝Aとします
    buf = ActiveCell.Address(True, False) ' 数値から列番号表示させるやつ
    buf = Left(buf, InStr(buf, "$") - 1)
    
    lastRow = Cells(Rows.Count, A).End(xlUp).Row 'その列の最終行を取得＝lastRowとします
    For i = 1 To lastRow  '1から最終行まで繰り返す

    Str1 = wS1.Cells(i, A)
    Str2 = wS2.Cells(i, "A")
    
     If InStr(Str1, Str2) <> 0 Then
    wS1.Cells(i, A).Offset(0, 1).Select '右隣のセルを選択
    Selection = "○"  '選択したセルに○って入れる
     End If
     
Next i

   MsgBox ("チェック完了!!")

    
End Sub

行動規範の内容に同意します

回答1件

ベストアンサー

NGワードのシートとアクティブシート両方を同時にループで参照してしまっているため不具合が起こっているのでしょう。
以下のように変更してみてください。各シートの最終行の取得部分はご自身で書いてみてくださいね。

vba
1
2    For i = 1 To [アクティブシートの最終行] 
3     For j = 1 To [NGワードシートの最終行] 
4
5    Str1 = wS1.Cells(i, A)
6    Str2 = wS2.Cells(j, "A")
7
8     If InStr(Str1, Str2) <> 0 Then
9    wS1.Cells(i, A).Offset(0, 1).Select '右隣のセルを選択
10    Selection = "○"  '選択したセルに○って入れる
11     End If
12
13    Next j
14   Next i

20180509 20:00追記

vba
1Dim counter As Long '数を数えるための変数
2    For i = 1 To [アクティブシートの最終行] 
3    counter = 0'アクティブシートの文章ごとに初期化
4     For j = 1 To [NGワードシートの最終行] 
5
6    Str1 = wS1.Cells(i, A)
7    Str2 = wS2.Cells(j, "A")
8
9     If InStr(Str1, Str2) <> 0 Then
10    wS1.Cells(i, A).Offset(0, 1).Select '右隣のセルを選択
11    Selection = "○"  '選択したセルに○って入れる
12    counter = counter + 1 'さらにヒットした数を数える
13     End If
14
15    Next j
16   Next i
17