VBA

Private Sub CommandButton1_Click()
Application.ReferenceStyle = xlA1

Dim checkRange As Variant
checkRange = InputBox("チェック起始の列番号を入力してくだい", "列", "H2:BA417")

Dim ignoreWordsList As Variant
ignoreWordsList = InputBox("除外キーワードを入力してくだい、複数が存在する場合は','で区切ってください", "Message", "181,203,206,214,277,281,287,306,307,310,311,314,315,323,324,325,326,327,328,329,330,351,352,353,354,355,356,357,358,359,360,365,366")
ignoreWordsList = Split(ignoreWordsList, ",")

Dim dic As Collection
Dim k As Integer
Set dic = New Collection

For k = 0 To UBound(ignoreWordsList)
dic.Add ignoreWordsList(k)
Next k

' Debug.Print checkRange

Dim strPattern As String: strPattern = "([！-～]+)"
Dim regEx As New RegExp
Dim strInput As String
Dim hasErrors As Boolean
hasErrors = False
Dim resultStr As String
Dim rng As Range, i As Integer, j As Integer
Set rng = Range(checkRange)
' Debug.Print rng.Rows.Count & "," & rng.Columns.Count
For i = 1 To rng.Rows.Count
For j = 1 To rng.Columns.Count
strInput = rng.Cells(RowIndex:=i, columnindex:=j).Value

With regEx
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = strPattern
End With
' Debug.Print strInput
If regEx.Test(strInput) Then
' Debug.Print Contains(dic, i) & i
If DoesItemExist(dic, CStr(i)) = False Then

rng.Cells(RowIndex:=i, columnindex:=j).Select
Application.ScreenUpdating = False
' Clear the color of all the cells
' Cells.Interior.ColorIndex = 0
' Highlight the active cell

resultStr = resultStr & "(" & "CELL:" & rng.Cells(RowIndex:=i, columnindex:=j).Address(RowAbsolute:=False, ColumnAbsolute:=False) & ") ⇒　" & strInput & vbCrLf
rng.Cells(RowIndex:=i, columnindex:=j).Interior.ColorIndex = 3
Application.ScreenUpdating = True
hasErrors = True
End If


Else

End If

Next
Next

If hasErrors = True Then
Dim myApp As String
' myApp = Shell("Notepad", vbNormalFocus)
' SendKeys resultStr, True
Else
MsgBox "全角文字が見つかりませんでした。"
End If

 

End Sub

Function DoesItemExist(mySet As Collection, myCheck As String) As Boolean
DoesItemExist = False
For Each elm In mySet
If myCheck = elm Then
DoesItemExist = True
Exit Function
End If
Next
End Function