Excel VBA | Range→配列→加工→高速書戻し の実務テンプレ

VBA
スポンサーリンク

ここでは 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ワードチェック+監査ログ作成」が一気に自動化できます。
さらに応用として「一致件数を集計してレポート化」や「一致セルを別ファイルに抽出」もできます。

VBA
スポンサーリンク
シェアする
@lifehackerをフォローする
スポンサーリンク
タイトルとURLをコピーしました