ここでは NGワードリストを別シートから読み込む + 一致したセルをログ出力する 実務テンプレートをまとめました。
NGワードリストを別シートから読み込む版
Sub RangeToArray_NGWordCheck_FromSheet()
Dim wsData As Worksheet
Dim wsNG As Worksheet
Dim rng As Range
Dim arr As Variant
Dim ngArr As Variant
Dim i As Long, j As Long, k As Long
Dim regEx As Object
' データシートとNGワードシートを指定
Set wsData = ThisWorkbook.Sheets("Sheet1") ' データ側
Set wsNG = ThisWorkbook.Sheets("NGWords") ' NGワードリスト側
' データ範囲
Set rng = wsData.Range("A1:C1000")
arr = rng.Value
' NGワードリストを配列に読み込み(A列にリストがある想定)
ngArr = wsNG.Range("A1", wsNG.Cells(wsNG.Rows.Count, "A").End(xlUp)).Value
' 正規表現オブジェクト
Set regEx = CreateObject("VBScript.RegExp")
regEx.IgnoreCase = True
regEx.Global = True
' チェック処理
For i = LBound(arr, 1) To UBound(arr, 1)
For j = LBound(arr, 2) To UBound(arr, 2)
If VarType(arr(i, j)) = vbString Then
For k = LBound(ngArr, 1) To UBound(ngArr, 1)
regEx.Pattern = ngArr(k, 1)
If regEx.Test(arr(i, j)) Then
rng.Cells(i, j).Interior.Color = vbRed
rng.Cells(i, j).Font.Bold = True
Exit For
End If
Next k
End If
Next j
Next i
' 書戻し
rng.Value = arr
End Sub
VB一致したセルをログ出力する版
一致したセルの情報を ログシート に書き出すテンプレートです。
Sub RangeToArray_NGWordCheck_LogOutput()
Dim wsData As Worksheet
Dim wsNG As Worksheet
Dim wsLog As Worksheet
Dim rng As Range
Dim arr As Variant
Dim ngArr As Variant
Dim i As Long, j As Long, k As Long
Dim regEx As Object
Dim logRow As Long
' シート指定
Set wsData = ThisWorkbook.Sheets("Sheet1")
Set wsNG = ThisWorkbook.Sheets("NGWords")
Set wsLog = ThisWorkbook.Sheets("Log")
' データ範囲
Set rng = wsData.Range("A1:C1000")
arr = rng.Value
' NGワードリスト
ngArr = wsNG.Range("A1", wsNG.Cells(wsNG.Rows.Count, "A").End(xlUp)).Value
' 正規表現
Set regEx = CreateObject("VBScript.RegExp")
regEx.IgnoreCase = True
regEx.Global = True
' ログ初期化
wsLog.Cells.Clear
wsLog.Range("A1:D1").Value = Array("Row", "Col", "Value", "MatchedPattern")
logRow = 2
' チェック処理+ログ出力
For i = LBound(arr, 1) To UBound(arr, 1)
For j = LBound(arr, 2) To UBound(arr, 2)
If VarType(arr(i, j)) = vbString Then
For k = LBound(ngArr, 1) To UBound(ngArr, 1)
regEx.Pattern = ngArr(k, 1)
If regEx.Test(arr(i, j)) Then
rng.Cells(i, j).Interior.Color = vbRed
rng.Cells(i, j).Font.Bold = True
' ログ出力
wsLog.Cells(logRow, 1).Value = i
wsLog.Cells(logRow, 2).Value = j
wsLog.Cells(logRow, 3).Value = arr(i, j)
wsLog.Cells(logRow, 4).Value = ngArr(k, 1)
logRow = logRow + 1
Exit For
End If
Next k
End If
Next j
Next i
' 書戻し
rng.Value = arr
End Sub
VB実務での活用イメージ
- 別シート管理 → NGワードリストを更新するだけでチェック対象が変わる
- ログ出力 → どのセルでどの NG ワードに一致したかを一覧化できる
- 応用 → ログを CSV に書き出す、メール通知する、なども可能
👉 このテンプレを使えば「NGワードチェック+監査ログ作成」が一気に自動化できます。
さらに応用として「一致件数を集計してレポート化」や「一致セルを別ファイルに抽出」もできます。
