| 
    
     |  | ▼くまけん さん: 
 >A列をB列にコピーしております。
 >数万行の複数のシートを処理しなくてはいけないため、
 >変更後はA列とB列を見直すことでチェックも出来るからと
 
 では、とりあえず、こんなふうに 確実なものだけB列に出力して
 みてはいかがでしょう?
 (B列にコピーしておく必要はありません)
 
 Sub 所有者コード判別()
 Dim 範囲 As Range
 Dim v As Variant
 Dim i As Long
 
 Set 範囲 = Range("A2", Cells(Rows.Count, 1).End(xlUp))
 v = 範囲.Value
 For i = 1 To UBound(v)
 Select Case True
 '確実なものから 仕分けする
 Case v(i, 1) Like "*会社*": v(i, 1) = "C"
 Case v(i, 1) Like "*(株)*":  v(i, 1) = "C"
 Case v(i, 1) Like "*(株)*": v(i, 1) = "C"
 Case v(i, 1) Like "*(有)*": v(i, 1) = "C"
 Case v(i, 1) Like "*会社*": v(i, 1) = "C"
 Case v(i, 1) Like "*法人*": v(i, 1) = "D"
 Case v(i, 1) Like "*神社*": v(i, 1) = "B"
 Case v(i, 1) Like "*寺*":  v(i, 1) = "B?"
 Case v(i, 1) Like "*宮*":  v(i, 1) = "B?"
 End Select
 Next
 範囲.Offset(, 1).Value = v
 MsgBox "判別不能な名称はA列のままです。編集してください"
 End Sub
 
 |  |