Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7761 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【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-2まち田マンション203　⇒「千葉県」「一川市」「妙典」「1-2まち田マンション203」（正しい）

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

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


'カウンタ
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　　 ' １項目の住所のデータ件数
Dim Gyou　　　　　　As Long　　 ' １項目の住所の行番号
Dim Retu　　　　　　As String　 ' １項目の住所の列番号
Dim Retub　　　　　 As Long　　 ' １項目住所の列番号（数値）
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　　　　　　　　 ' 文字位置（市区郡２）

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

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

End Sub

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

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

'----１セル（行）の処理 ------------------------------

Gyou = 2
Retu = "a"　　　' １項目住所の列番号（文字）
Retub = 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ファイルの郵便番号簿
>を利用します。それは、都道府県、市区町村、町域名に分かれています
郵政の１２万件くらいあるやつですよね。
それを利用することも考えたのですが、たとえば北海道札幌市中央区××の場合、
わたしは「北海道」「札幌市」「中央区」「××」にしたいのですが、
郵政のは「北海道」「札幌市中央区」「××」になっています。

もうすこし考えてみます。どうもありがとうございました。
【36941】Re:住所をうまく切るには
回答  neptune  - 06/4/18(火) 17:38 -
引用なし
パスワード
   ▼にしもり さん：
>それを利用することも考えたのですが、たとえば北海道札幌市中央区××の場合、
>わたしは「北海道」「札幌市」「中央区」「××」にしたいのですが、
>郵政のは「北海道」「札幌市中央区」「××」になっています。
>
>もうすこし考えてみます。どうもありがとうございました。
mdbを前提の、思いつきですから、真剣にはロジックを考えては無いですが、
あのファイルには自治体コードがありますよね。
その自治体コードから１つずつ、データを抜き取って、それぞれ比較していったら
どうでしょう？そして違う部分と、同じ部分を分けるとか？

確か、たいした数にはならなかった記憶があります。
万の桁までは無かったと思う。
【36961】Re:住所をうまく切るには
回答  クロ  - 06/4/19(水) 9:25 -
引用なし
パスワード
   VBAは分かりませんが
爺爺岳さんの式で分割できると思います。
エクセル技道場の２６番下の方にあるので間違えないで下さい。
静岡市と堺市を追加する必要があります。
http://www2.odn.ne.jp/excel/waza/function.html
【36979】Re:住所をうまく切るには
質問  にしもり  - 06/4/19(水) 12:20 -
引用なし
パスワード
   ▼クロ さん、neptuneさん：
アドバイスまことにありがとうございました。
大、大、大進歩であります。
マクロをやめ、爺さんのEXCEL式を参考にシート上で変換行なうことにしました。

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


２行目は次のとおり。
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 -
引用なし
パスワード
   ▼クロ さん：
ああー、ほんとですね。
ありがとうございます。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7761 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free