VBA(Excel)での文字列抜き出し方法について

質問

質問させていただきます。

現在作成しているエクセルのシートのＢ列に○○市○○町○○ー○などの住所が入っているデータがあります。
そのＢ列のデータから、○○市の部分だけを判別し、
○○市ならＡ列に１というデータを入れ
△△市ならＡ列に２というデータを入れる
と言ったようなマクロを作ろうと思っています。

現状、文字列を抜き出すところまでは分かったのですが、
市の名前が２文字だったり、３文字だったりとバラバラなので、
非常に困っています。

詳しい方いらっしゃいましたら、教えていただけると助かります。

よろしくお願いいたします。

回答No.1

noname#140971 · ベストアンサー

＞現状、文字列を抜き出すところまでは分かったのですが・・・

そうでしょうか？
あらゆる住所から市名を完全に抜き出すはおよそ不可能に近いです。

[イミディエイト]
? SplitAddress("県" & "○○市○○町○○ー○", 市区郡)
○○市

関数 SplitAddress()は、一見、'○○市'の抜き出しに成功しています。

? SplitAddress("県" & "市川市○○町○○ー○", 市区郡)
市川市

関数 SplitAddress()は、'市川市'の抜き出しにも成功しています。
しかし、これは抜き出すルーチン以前で BX() で'市川市'を'03_いちかわ市'に変換しています。
そうして抜き出した後に　AX() で'市川市'に戻しています。
問題は、BX()とAX()での事前変換と事後変換するデータ準備の完璧さをいかに確保するかでしょう。

なお、 SplitAddress()では、市区郡が重複していても警告メッセージを表示していません。
少なくとも、SplitAddress()の機能をそこまでに改善して用いるべきかと思います。

Public Const 都道府県 = 1
Public Const 市区郡 = 2
Public Const 市区郡の町村 = 3
Public Const 町村番地 = 4

ublic Function SplitAddress(ByVal strAddress As String, ByVal N As Integer) As String
　　Dim strReturn As String

　　strAddress = BX(strAddress)
　　Select Case N
　　　　Case 1
　　　　　　strReturn = Trim(CutText(" " & strAddress, "東京都,北海道,京都府,大阪府,県", 1, True))
　　　　Case 2
　　　　　　strReturn = CutText(CutText(strAddress, "東京都,北海道,京都府,大阪府,県", 2, , True), "市,区,郡", 1, True)
　　　　Case 3
　　　　　　strReturn = CutText(CutText(CutText(strAddress, "東京都,北海道,京都府,大阪府,県", 2, , True), "市,区,郡", 2, , True), "町,村", 1, True)
　　　　Case 4
　　　　　　If CharCount(strAddress, "市") Or CharCount(strAddress, "区") Or CharCount(strAddress, "郡") Then
　　　　　　　　strReturn = CutText(CutText(strAddress, "東京都,北海道,京都府,大阪府,県", 2, , True), "市,区,郡", 2, , True)
　　　　　　Else
　　　　　　　　strReturn = CutText(strAddress, "東京都,北海道,京都府,大阪府,県", 2, , True)
　　　　　　End If
　　　　Case Else
　　End Select
　　SplitAddress = AX(strReturn)
End Function

Public Function CutText(ByVal Text As String, _
　　　　　　　　　　　 ByVal Separator As String, _
　　　　　　　　　　　 ByVal N As Integer, _
　　　　　　　　　　　 Optional ws As Boolean = False, _
　　　　　　　　　　　 Optional ALL As Boolean = False) As String
　　Dim I　　　　　　　As Integer
　　Dim M　　　　　　　As Integer
　　Dim strSeparator() As String
　　Dim strReturn　　　As String

　　strSeparator() = Split(Separator, ",")
　　M = UBound(strSeparator())
　　For I = 0 To M
　　　　If CharCount(Text, strSeparator(I)) Then
　　　　　　strReturn = CS(Text, strSeparator(I), N, ws, ALL)
　　　　End If
　　Next I
　　CutText = strReturn
End Function

Public Function CharCount(ByVal Text As String, ByVal C As String) As Integer
　　CharCount = Len(Text) - Len(Replace(Text, C, ""))
End Function

Public Function BX(ByVal Text As String) As String
　　Text = Replace(Text, "郡山郡", "01_こおりやま郡")
　　Text = Replace(Text, "市川市八幡", "市川市02_八幡町")
　　Text = Replace(Text, "市川市", "03_いちかわ市")
　　Text = Replace(Text, "町田市", "04_まちだ市")
　　Text = Replace(Text, "小郡町", "05_おごおり町")
　　BX = Text
End Function

Public Function AX(ByVal Text As String) As String
　　Text = Replace(Text, "01_こおりやま", "郡山")
　　Text = Replace(Text, "02_八幡町", "八幡")
　　Text = Replace(Text, "03_いちかわ", "市川")
　　Text = Replace(Text, "04_まちだ", "町田")
　　Text = Replace(Text, "05_おごおり", "小郡")
　　AX = Text
End Function

Public Function CS(ByVal Text As String, _
　　　　　　　　　 ByVal Separator As String, _
　　　　　　　　　 ByVal N As Integer, _
　　　　　　　　　 Optional ws As Boolean = False, _
　　　　　　　　　 Optional ALL As Boolean = False) As String
　　Dim I　　　　　As Integer
　　Dim M　　　　　As Integer
　　Dim strDatas() As String
　　Dim strReturn　As String

　　strDatas = Split("" & Separator & Text, Separator, , 0)
　　M = UBound(strDatas())
　　If N > M Then
　　　　strReturn = ""
　　ElseIf ALL Then
　　　　M = M - 1
　　　　For I = N To M
　　　　　　strReturn = strReturn & strDatas(I) & Separator
　　　　Next I
　　　　strReturn = strReturn & strDatas(M + 1)
　　Else
　　　　strReturn = strDatas(N) & IIf(ws And Len(strDatas(N)), Separator, "")
　　End If
　　CS = strReturn
End Function

補足

ご回答ありがとうございます。

説明不足ですいません。
検索するのは全ての市ではなく、あるデータベースのある区域のデータなので、
市川市のような特別なパターンはありません。
多くても１０個程度の市町村です。

回答No.2

noname#140971

[イミディエイト]
? switch（"○○市"="○○市",1,"○○市"="△△市", 2)
1
? switch（"△△市"="○○市",1,"△△市"="△△市", 2)
2

switch が使えると思います。