| |
▼Abyss さん
御指南ありがとうございます。
おかげさまで下記のようにだいぶすっきりさせることができました
こうなるとまた欲が出てきまして
ループ処理を何度か繰り返していますが
これを1度でやる方法などはあるのでしょうか
ありましたら教えていただきたく思います。
Dim RE, strPattern As String
Dim r As Range, LP, Endcol As Long
Endcol = Cells(1, Columns.Count).End(xlToLeft).Column
Rows(2).Clear
Set RE = CreateObject("VBScript.RegExp")
With RE
.Pattern = "(|青森|岩手|宮城|秋田|山形)県||^不明" ''検索パターンを設定
.IgnoreCase = True ''大文字と小文字を区別しない
.Global = True ''文字列全体を検索
For LP = 1 To Endcol
If .Test(Cells(1, LP).Formula) Then Cells(2, LP) = "その他"
Next LP
.Pattern = "(北海道)" ''検索パターンを設定
For LP = 1 To Endcol
If .Test(Cells(1, LP).Formula) Then Cells(2, LP) = "北海道地方"
Next LP
.Pattern = "^(?:茨城|栃木|群馬|埼玉|千葉|神奈川)県|^東京都" ''検索パターンを設定
For LP = 1 To Endcol
If .Test(Cells(1, LP).Formula) Then Cells(2, LP) = "関東"
Next LP
.Pattern = "^(?:新潟|富山|石川|福井)県" ''検索パターンを設定
For LP = 1 To Endcol
If .Test(Cells(1, LP).Formula) Then Cells(2, LP) = "北陸"
Next LP
.Pattern = "^(?:山梨|長野|岐阜|静岡|愛知)県" ''検索パターンを設定
For LP = 1 To Endcol
If .Test(Cells(1, LP).Formula) Then Cells(2, LP) = "中部"
Next LP
.Pattern = "(三重|滋賀|兵庫|奈良|和歌山)県|(京都|大阪)府" ''検索パターンを設定
For LP = 1 To Endcol
If .Test(Cells(1, LP).Formula) Then Cells(2, LP) = "近畿"
Next LP
.Pattern = "(鳥取|島根|岡山|広島|山口|徳島|香川|愛媛|高知)県" ''検索パターンを設定
For LP = 1 To Endcol
If .Test(Cells(1, LP).Formula) Then Cells(2, LP) = "中国/四国"
Next LP
.Pattern = "(福岡|佐賀|長崎|熊本|大分|宮崎|鹿児)県" ''検索パターンを設定
For LP = 1 To Endcol
If .Test(Cells(1, LP).Formula) Then Cells(2, LP) = "九州"
Next LP
.Pattern = "(沖縄県)" ''検索パターンを設定
For LP = 1 To Endcol
If .Test(Cells(1, LP).Formula) Then Cells(2, LP) = "沖縄"
Next LP
End With
Set RE = Nothing
|
|
HAM
- 09/4/14(火) 14:03 -
