Excel VBA質問箱 IV

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

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


7762 / 13645 ツリー ←次へ | 前へ→

【36934】住所をうまく切るには にしもり 06/4/18(火) 14:54 質問[未読]
【36935】Re:住所をうまく切るには neptune 06/4/18(火) 15:06 回答[未読]
【36936】Re:住所をうまく切るには にしもり 06/4/18(火) 15:12 お礼[未読]
【36941】Re:住所をうまく切るには neptune 06/4/18(火) 17:38 回答[未読]
【36961】Re:住所をうまく切るには クロ 06/4/19(水) 9:25 回答[未読]
【36979】Re:住所をうまく切るには にしもり 06/4/19(水) 12:20 質問[未読]
【36981】Re:住所をうまく切るには neptune 06/4/19(水) 12:55 回答[未読]
【36987】Re:住所をうまく切るには にしもり 06/4/19(水) 13:50 お礼[未読]
【36988】Re:住所をうまく切るには にしもり 06/4/19(水) 13:54 質問[未読]
【36989】Re:住所をうまく切るには にしもり 06/4/19(水) 13:58 お礼[未読]
【37011】Re:住所をうまく切るには クロ 06/4/19(水) 19:01 回答[未読]
【37043】Re:住所をうまく切るには にしもり 06/4/20(木) 9:02 お礼[未読]

【36934】住所をうまく切るには
質問  にしもり  - 06/4/18(火) 14:54 -

引用なし
パスワード
   あるキャンペーンで顧客に紹介する店の住所を、システムに登録しています。
その際下記マクロで住所を住所1〜4にわけています。
例1:千葉県一川市妙典1-2まち田マンション203 ⇒「千葉県」「一川市」「妙典」「1-2まち田マンション203」(正しい)

ところがうまくいかないことがあります。
例2:千葉県市川市妙典1-2町田マンション203 ⇒「千葉県」「市」「川市」「妙典1-2町田マンション203」(ダメ)
例3:千葉県一川市妙典1-2町田マンション203 ⇒「千葉県」「一川市」「妙典1-2町」「田マンション203」(ダメ)

例2の場合は住所2が市川市に、例3の場合は住所3が「妙典」になるようにするにはどこをどう改善すればよいでしょうか。


'カウンタ
Dim i As Long
Dim iCnt  As Long
Dim iCnt1  As Long
Dim iCnt2  As Long
Dim iCnt3  As Long
Dim iCnt4  As Long

Dim Saisyuu_gyou  As Long   ' 1項目の住所のデータ件数
Dim Gyou      As Long   ' 1項目の住所の行番号
Dim Retu      As String  ' 1項目の住所の列番号
Dim Retub      As Long   ' 1項目住所の列番号(数値)
Dim c
Dim Kennsaku_moji  As String  ' 検索する文字(都道府県)
Dim Kennsaku_moji1 As String  ' 検索する文字(市区郡)
Dim Kennsaku_moji2 As String  ' 検索する文字(区町村)
Dim Kennsaku_moji3 As String  ' 検索する文字(地名・字名)
Dim Kennsaku_moji4 As String  ' 検索する文字(番地)

Dim v  As Long         ' 文字位置(番地)
Dim w  As Long         ' 文字位置(番地)最小値
Dim x  As Long         ' 文字位置(都道府県)
Dim y  As Long         ' 文字位置(市区郡)
Dim z  As Long         ' 文字位置(市区郡2)

'*************************************************
' 住所データから4項目住所データに分割する。
'*************************************************
Sub 分割start()

  Module1.Juusyo_bunnkatu
  MsgBox "住所分割、処理終了しました。"

End Sub

'*************************************
' 都道府県の確定
'*************************************
Sub Juusyo_bunnkatu()

Sheets("住所入力シート").Activate

'----1セル(行)の処理 ------------------------------

Gyou = 2
Retu = "a"   ' 1項目住所の列番号(文字)
Retub = 1    ' 1項目住所の列番号(数値) ------- retuとretubとは、連動させること。

Saisyuu_gyou = Range(Retu & Gyou).CurrentRegion.Rows.Count

For i = Gyou To Saisyuu_gyou + Gyou
  x = 0
  y = 0
  z = 0
  w = 0
  v = 0
  For iCnt = 1 To 5
    If iCnt = 1 Then Kennsaku_moji = "県"
    If iCnt = 2 Then Kennsaku_moji = "府"   '京都府の場合、都を左記に検索処理すると京都で区切るので、
    If iCnt = 3 Then Kennsaku_moji = "都"   '先に府で検索処理させる。
    If iCnt = 4 Then Kennsaku_moji = "道"
    If iCnt = 5 Then
      x = 0
      Module1.Juusyo_set1   '市区郡へ
    Else
      x = InStr(Range(Retu & Gyou), Kennsaku_moji)
      If x > 0 Then
        Module1.Juusyo_set1   '市区郡へ
        Exit For
      End If
    End If
  Next
  
  Module1.Sheet_Set   'シートに反映

  Gyou = Gyou + 1

Next

Module1.Kana_Set

End Sub

'*************************************
' 市区郡の確定
'*************************************

Sub Juusyo_set1()

   ' ---- 第2検索文字での検索・処理 ----------------
  For iCnt1 = 1 To 6
    If iCnt1 = 1 Then Kennsaku_moji1 = "市"
    If iCnt1 = 2 Then Kennsaku_moji1 = "区"
    If iCnt1 = 3 Then Kennsaku_moji1 = "郡"
    If iCnt1 = 4 Then Kennsaku_moji1 = "町"
    If iCnt1 = 5 Then Kennsaku_moji1 = "村"
    If iCnt1 = 6 Then
      Exit For
    Else
      y = InStr(x + 1, Range(Retu & Gyou), Kennsaku_moji1)
      If y > 0 Then
        Module1.Juusyo_set2   '区町村へ
        Exit For
      End If
    End If
  Next
  
End Sub

'*************************************
' 区町村の確定
'*************************************
Sub Juusyo_set2()

   ' ---- 第3検索文字での検索・処理 ----------------
  For iCnt2 = 1 To 6
    If iCnt2 = 1 Then Kennsaku_moji2 = "市"
    If iCnt2 = 2 Then Kennsaku_moji2 = "区"
    If iCnt2 = 3 Then Kennsaku_moji2 = "町"
    If iCnt2 = 4 Then Kennsaku_moji2 = "村"
    'If iCnt2 = 5 Then Kennsaku_moji2 = "郡"
    If iCnt2 = 5 Then
      z = y
      If z > 0 Then
        Module1.Juusyo_set3
        Exit For
      End If
    Else
      z = InStr(y + 1, Range(Retu & Gyou), Kennsaku_moji2)
      If z > 0 Then
        Module1.Juusyo_set3
        Exit For
      End If
    
    End If
  Next
  
End Sub
 
'*************************************
' 地名・字名の確定
'*************************************
Sub Juusyo_set3()

  For iCnt3 = 1 To 9
    '半角数字
    Kennsaku_moji3 = Trim(Str(iCnt3))
    v = InStr(z + 1, Range(Retu & Gyou), Kennsaku_moji3)
    If v = 0 Then
      '全角数字
      Kennsaku_moji3 = Trim(StrConv(Str(iCnt3), vbWide))
      v = InStr(z + 1, Range(Retu & Gyou), Kennsaku_moji3)
    End If
    If v <> 0 Then
      If w = 0 Or w > v Then
        w = v
      End If
    End If
  Next

End Sub

'*************************************
' 分割した住所をシートに反映
'*************************************
Sub Sheet_Set()

  If x > 0 Then
    Cells(Gyou, Retub + 1) = Mid(Range(Retu & Gyou), 1, x)
  End If
  If y > 0 Then
    Cells(Gyou, Retub + 2) = Mid(Range(Retu & Gyou), x + 1, y - x)
  End If
  If z > 0 Then
    If y = z And w > 0 Then
      Cells(Gyou, Retub + 4) = Mid(Range(Retu & Gyou), y + 1, (w - 1) - y)
      Cells(Gyou, Retub + 6) = Mid(Range(Retu & Gyou), w, Len(Range(Retu & Gyou)) - (w - 1))
    Else
      Cells(Gyou, Retub + 4) = Mid(Range(Retu & Gyou), y + 1, z - y)
      Cells(Gyou, Retub + 6) = Mid(Range(Retu & Gyou), z + 1, Len(Range(Retu & Gyou)) - z)
    End If
  End If
  
End Sub

'*************************************
' カナの設定
'*************************************
Sub Kana_Set()

  '最終行
  Selection.SpecialCells(xlCellTypeLastCell).Select
  endr = ActiveCell.Row
  '-------------------
  'セル列のカナ設定
  '-------------------
  '市区郡
  Range(Cells(1, 3), Cells(endr, 3)).SetPhonetic
  Range(Cells(1, 3), Cells(endr, 3)).Select
  Selection.Phonetics.CharacterType = xlKatakana
  '区町村
  Range(Cells(1, 5), Cells(endr, 5)).SetPhonetic
  Range(Cells(1, 5), Cells(endr, 5)).Select
  Selection.Phonetics.CharacterType = xlKatakana
  '地名・字名・番地
  Range(Cells(1, 7), Cells(endr, 7)).SetPhonetic
  Range(Cells(1, 7), Cells(endr, 7)).Select
  Selection.Phonetics.CharacterType = xlKatakana
  
  '-------------------
  'フリカナの入力
  '-------------------
  '市区郡
  Range(Cells(1, 4), Cells(endr, 4)).Formula = "=PHONETIC(c1)"
  Range("c1").Select
  '区町村
  Range(Cells(1, 6), Cells(endr, 6)).Formula = "=PHONETIC(e1)"
  Range("e1").Select
  '地名・字名・番地
  Range(Cells(1, 8), Cells(endr, 8)).Formula = "=PHONETIC(g1)"
  Range("g1").Select
  
End Sub

【36935】Re:住所をうまく切るには
回答  neptune  - 06/4/18(火) 15:06 -

引用なし
パスワード
   ▼にしもり さん:
全ての住所に対応させるのは恐らく出来ないと思います。
にしもりさんが例にあげているようなものが全国にあるからです。
それをすべて網羅するのは不可能とは言いませんが、私が知らないだけかも
しれませんが手作業になるかもしれません。

こういう場合は、郵政公社からDLできるCSVファイルの郵便番号簿
を利用します。それは、都道府県、市区町村、町域名に分かれていますから
郵便番号で検索するプログラムを作成することが多いようです。

【36936】Re:住所をうまく切るには
お礼  にしもり  - 06/4/18(火) 15:12 -

引用なし
パスワード
   ▼neptune さん:
ありがとうございます。

>
>こういう場合は、郵政公社からDLできるCSVファイルの郵便番号簿
>を利用します。それは、都道府県、市区町村、町域名に分かれています
郵政の12万件くらいあるやつですよね。
それを利用することも考えたのですが、たとえば北海道札幌市中央区××の場合、
わたしは「北海道」「札幌市」「中央区」「××」にしたいのですが、
郵政のは「北海道」「札幌市中央区」「××」になっています。

もうすこし考えてみます。どうもありがとうございました。

【36941】Re:住所をうまく切るには
回答  neptune  - 06/4/18(火) 17:38 -

引用なし
パスワード
   ▼にしもり さん:
>それを利用することも考えたのですが、たとえば北海道札幌市中央区××の場合、
>わたしは「北海道」「札幌市」「中央区」「××」にしたいのですが、
>郵政のは「北海道」「札幌市中央区」「××」になっています。
>
>もうすこし考えてみます。どうもありがとうございました。
mdbを前提の、思いつきですから、真剣にはロジックを考えては無いですが、
あのファイルには自治体コードがありますよね。
その自治体コードから1つずつ、データを抜き取って、それぞれ比較していったら
どうでしょう?そして違う部分と、同じ部分を分けるとか?

確か、たいした数にはならなかった記憶があります。
万の桁までは無かったと思う。

【36961】Re:住所をうまく切るには
回答  クロ  - 06/4/19(水) 9:25 -

引用なし
パスワード
   VBAは分かりませんが
爺爺岳さんの式で分割できると思います。
エクセル技道場の26番下の方にあるので間違えないで下さい。
静岡市と堺市を追加する必要があります。
http://www2.odn.ne.jp/excel/waza/function.html

【36979】Re:住所をうまく切るには
質問  にしもり  - 06/4/19(水) 12:20 -

引用なし
パスワード
   ▼クロ さん、neptuneさん:
アドバイスまことにありがとうございました。
大、大、大進歩であります。
マクロをやめ、爺さんのEXCEL式を参考にシート上で変換行なうことにしました。

1行目はタイトル。
A1 変換前住所
B1 都道府県
C1 市区郡
E1 区町村
G1 地名・字名・番地
I1 作業セル1
J1 作業セル2


2行目は次のとおり。
A2 変換前住所を入れるところ
B2 =LEFT(A2,4-SUM((MID(A2,3,1)={"都","道","府","県"})*1))
C2 =IF(B2="東京都",IF(COUNT(FIND({"東村山","武蔵村","羽村市"},LEFT(I2,3))),LEFT(I2,FIND("市",I2)),LEFT(I2,MIN(FIND({"市","区","町","村"},I2&"市区町村",2)))),IF(COUNT(FIND({"今市市","四日市","八日市","廿日市"},LEFT(I2,3))),LEFT(I2,FIND("市",I2,FIND("市",I2)+1)),IF(IF(COUNT(FIND({"蒲郡市","大和郡","小郡市"},LEFT(I2,3))),"市",IF(COUNT(FIND({"余市郡","高市郡"},LEFT(I2,3))),"郡",MID(I2,MIN(FIND({"市","郡"},I2&"市郡",2)),1)))="市",IF(COUNT(FIND({"札幌市","仙台市","千葉市","横浜市","川崎市","名古屋","京都市","大阪市","神戸市","広島市","北九州","福岡市"},LEFT(I2,3))),LEFT(I2,FIND("区",I2)),LEFT(I2,FIND("市",I2,2))),IF(COUNT(FIND({"佐波郡玉村","恵那郡岩村","東宇和郡野","杵島郡大町","北松浦郡鹿"},LEFT(I2,5))),LEFT(I2,FIND("郡",I2)+3),LEFT(I2,MIN(FIND({"町","村"},I2&"町村",FIND("郡",I2)+2)))))))
E2 =RIGHT(J2,LEN(J2)-(LEN(B2)+LEN(C2)))
G2 =RIGHT(A2,LEN(A2)-LEN(J2))
I2 =RIGHT(A2,LEN(A2)-LEN(B2))
J2 =LEFT(A2,MIN(FIND({0,1,2,3,4,5,6,7,8,9},ASC(A2)&1234567890))-1)

その結果、千葉県市川市妙典1-2は、「千葉県」「市川市」「妙典」「1-2」になりました。
ありがとうございました。

ですが、もうひとつあるのです。
政令指定都市の場合、いまのままですと次のようになります。
千葉県千葉市緑区おゆみ野1-1は、「千葉県」「千葉市緑区」「おゆみ野」「1-1」

実は政令指定都市のときだけ以下のようにしたいのです。
千葉県千葉市緑区おゆみ野1-1は、「千葉県」「千葉市」「緑区」「おゆみ野1-1」

考えてみていますが困難です。よいアドバイスがありましたらお願いします。

【36981】Re:住所をうまく切るには
回答  neptune  - 06/4/19(水) 12:55 -

引用なし
パスワード
   良く見てないんですが、
爺爺岳さんの式も、私の言ったように例外を判断しているようです。

せっかく一番手間の掛かる例外を出してくれているのだから、
それを「政令指定都市の場合」をカバーするようにVBAに書き換えればいいだけです。
勿論、「政令指定都市の場合」は自分で考えなければならない様ですけどね。
ただ、関数より合併などに係わる変更処理はVBAの方が楽と思います。

手順としては
殆どの地名に共通する規則と、
それに当てはまらない例外はリスト化して、
変換対象のデータと比較し、どちらに該当するか判断、
分解処理
するだけのことです。

何度も言うように一番手間の掛かるのが例外を抽出する部分ですが、
これもロジックを考え、VBAで書いてやればOK。
Accessでやれば比較的簡単に出来ると思いますが?

マクロを止めたんでしたら、私もここまでで失礼します。

【36987】Re:住所をうまく切るには
お礼  にしもり  - 06/4/19(水) 13:50 -

引用なし
パスワード
   ▼neptune さん:
>
>何度も言うように一番手間の掛かるのが例外を抽出する部分ですが、

おっしゃるとおり例外を抽出する部分がネックです。
シート上でやるにしろVBAで再トライするにしろアドバイスいただいた考え方で例外に対処してみたいとおもいます。
ここまでどうもありがとうございました。

【36988】Re:住所をうまく切るには
質問  にしもり  - 06/4/19(水) 13:54 -

引用なし
パスワード
   ▼クロ さん:
静岡市は政令指定都市なので追加というのはわかりますが、堺市はなんのために追加ですか?
まだよくわかっていないかもしれません。
すみません。おしえてください。

【36989】Re:住所をうまく切るには
お礼  にしもり  - 06/4/19(水) 13:58 -

引用なし
パスワード
   ▼にしもり さん:
堺市は18年4月から政令指定都市になったのですね。
ネットで調べてはじめて知りました。
堺市民のかたすみません。

【37011】Re:住所をうまく切るには
回答  クロ  - 06/4/19(水) 19:01 -

引用なし
パスワード
   こんにちは
さいたま市が抜けているようです。
http://www.efcit.co.jp/cgi-bin2/wwwlng.cgi?print+200411/04110035.txt

【37043】Re:住所をうまく切るには
お礼  にしもり  - 06/4/20(木) 9:02 -

引用なし
パスワード
   ▼クロ さん:
ああー、ほんとですね。
ありがとうございます。

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