|
>これを1度でやる方法などはあるのでしょうか
正規表現Pattern設定としてはないです。
しかし、ご提示のコードだったら、For Loopを
使い、視覚的にも分かりやすくは可能でしょう。
Dim oReg As Object
Dim r As Range
Dim LP As Long, Endcol As Long
Dim e, v
Dim i As Long
Endcol = Cells(1, Columns.Count).End(xlToLeft).Column
Rows(2).Clear
Set oReg = CreateObject("VBScript.RegExp")
oReg.Global = True
v = VBA.Array("その他", "北海道地方", "関東", "北陸", _
"中部", "近畿", "中国/四国", "九州", "沖縄")
For Each e In Array("^(?:青森|岩手|宮城|秋田|山形)県|^不明", _
"^北海道", _
"^(?:茨城|栃木|群馬|埼玉|千葉|神奈川)県|^東京都", _
"^(?:新潟|富山|石川|福井)県", _
"^(?:山梨|長野|岐阜|静岡|愛知)県", _
"^(?:三重|滋賀|兵庫|奈良|和歌山)県|^(?:京都|大阪)府", _
"^(?:鳥取|島根|岡山|広島|山口|徳島|香川|愛媛|高知)県", _
"^(?:福岡|佐賀|長崎|熊本|大分|宮崎|鹿児)県", _
"^沖縄県")
oReg.Pattern = CStr(e)
For LP = 1 To Endcol
If oReg.Test(Cells(1, LP)) Then Cells(2, LP).Value = CStr(v(i))
Next
i = i + 1
Next
Set oReg = Nothing
|
|