Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


3610 / 13646 ツリー ←次へ | 前へ→

【61145】正規表現による文字の置換 HAM 09/4/11(土) 17:01 質問[未読]
【61146】Re:正規表現による文字の置換 Abyss 09/4/11(土) 17:13 回答[未読]
【61147】Re:正規表現による文字の置換 Abyss 09/4/11(土) 17:22 回答[未読]
【61169】Re:正規表現による文字の置換 HAM 09/4/14(火) 14:03 発言[未読]
【61174】Re:正規表現による文字の置換 Abyss 09/4/14(火) 15:33 回答[未読]
【61175】Re:正規表現による文字の置換 HAM 09/4/14(火) 15:43 お礼[未読]

【61145】正規表現による文字の置換
質問  HAM  - 09/4/11(土) 17:01 -

引用なし
パスワード
   県名からエリアを記載するコードを見よう見まねで下記の通り書きました
一応の目的は達成できたかに見えたのですが
セル内に「東京都」の場合のみエリアを出すようにしたかったのですが
「あ東京都あ」と記載されているセルにも対象となってしまいました
根本的に間違っているような気がしますがどう直せばよいのかわかりません
御助力をお願い致します。

Sub 正規表現置換()
  Dim RE, strPattern, strPattern2, strPattern3, strPattern4, _
  strPattern5, strPattern6, strPattern7, strPattern8, strPattern9 As String
  Dim r As Range, LP As Long
    Rows(2).Clear
  Set RE = CreateObject("VBScript.RegExp")
  strPattern = "(北海道)"
  With RE
    .Pattern = strPattern    ''検索パターンを設定
    .IgnoreCase = True     ''大文字と小文字を区別しない
    .Global = True       ''文字列全体を検索
    For LP = 1 To 50
      If .Test(Cells(1, LP).Formula) Then Cells(2, LP) = "北海道地方"
    Next LP
  End With
  strPattern2 = "(茨城県|栃木県|群馬県|埼玉県|千葉県|東京都|神奈川県)"
  With RE
    .Pattern = strPattern2    ''検索パターンを設定
    .IgnoreCase = True     ''大文字と小文字を区別しない
    .Global = True       ''文字列全体を検索
    For LP = 1 To 50
      If .Test(Cells(1, LP).Formula) Then Cells(2, LP) = "関東"
    Next LP
  End With
  strPattern3 = "(新潟県|富山県|石川県|福井県)"
  With RE
    .Pattern = strPattern3    ''検索パターンを設定
    .IgnoreCase = True     ''大文字と小文字を区別しない
    .Global = True       ''文字列全体を検索
    For LP = 1 To 50
      If .Test(Cells(1, LP).Formula) Then Cells(2, LP) = "北陸"
    Next LP
  End With
  strPattern4 = "(山梨県|長野県|岐阜県|静岡県|愛知県)"
  With RE
    .Pattern = strPattern4    ''検索パターンを設定
    .IgnoreCase = True     ''大文字と小文字を区別しない
    .Global = True       ''文字列全体を検索
    For LP = 1 To 50
      If .Test(Cells(1, LP).Formula) Then Cells(2, LP) = "中部"
    Next LP
  End With
  strPattern5 = "(三重県|滋賀県|京都府|大阪府|兵庫県|奈良県|和歌山県)"
  With RE
    .Pattern = strPattern5    ''検索パターンを設定
    .IgnoreCase = True     ''大文字と小文字を区別しない
    .Global = True       ''文字列全体を検索
    For LP = 1 To 50
      If .Test(Cells(1, LP).Formula) Then Cells(2, LP) = "近畿"
    Next LP
  End With
  strPattern6 = "(鳥取県|島根県|岡山県|広島県|山口県|徳島県|香川県|愛媛県|高知県)"
  With RE
    .Pattern = strPattern6   ''検索パターンを設定
    .IgnoreCase = True     ''大文字と小文字を区別しない
    .Global = True       ''文字列全体を検索
    For LP = 1 To 50
      If .Test(Cells(1, LP).Formula) Then Cells(2, LP) = "中国/四国"
    Next LP
  End With
  strPattern7 = "(福岡県|佐賀県|長崎県|熊本県|大分県|宮崎県|鹿児島県)"
  With RE
    .Pattern = strPattern7    ''検索パターンを設定
    .IgnoreCase = True     ''大文字と小文字を区別しない
    .Global = True       ''文字列全体を検索
    For LP = 1 To 50
      If .Test(Cells(1, LP).Formula) Then Cells(2, LP) = "九州"
    Next LP
  End With
  strPattern8 = "(沖縄県)"
  With RE
    .Pattern = strPattern8    ''検索パターンを設定
    .IgnoreCase = True     ''大文字と小文字を区別しない
    .Global = True       ''文字列全体を検索
    For LP = 1 To 50
      If .Test(Cells(1, LP).Formula) Then Cells(2, LP) = "沖縄"
    Next LP
  End With
  strPattern9 = "(不明|青森県|岩手県|宮城県|秋田県|山形県|福島県)"
  With RE
    .Pattern = strPattern9    ''検索パターンを設定
    .IgnoreCase = True     ''大文字と小文字を区別しない
    .Global = True       ''文字列全体を検索
    For LP = 1 To 50
      If .Test(Cells(1, LP).Formula) Then Cells(2, LP) = "その他"
    Next LP
  End With
  Set RE = Nothing
End Sub

【61146】Re:正規表現による文字の置換
回答  Abyss  - 09/4/11(土) 17:13 -

引用なし
パスワード
   >「あ東京都あ」と記載されているセルにも対象となってしまいました

文字列が県名で始まる条件をつければよいのでは??

 Pattern = "^(茨城県|栃木県|群馬県|埼玉県|千葉県|東京都|神奈川県)"

【61147】Re:正規表現による文字の置換
回答  Abyss  - 09/4/11(土) 17:22 -

引用なし
パスワード
   それに無駄も多いので、↓のような
書き方でいいと思います。

Pattern = "^(?:茨城|栃木|群馬|埼玉|千葉|神奈川)県|^東京都"

【61169】Re:正規表現による文字の置換
発言  HAM  - 09/4/14(火) 14:03 -

引用なし
パスワード
   ▼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

【61174】Re:正規表現による文字の置換
回答  Abyss  - 09/4/14(火) 15:33 -

引用なし
パスワード
   >これを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

【61175】Re:正規表現による文字の置換
お礼  HAM  - 09/4/14(火) 15:43 -

引用なし
パスワード
   ▼Abyss さん重ねてありがとうございます
おかげさまでとてもすっきりしました

3610 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free