vba 住所で判断して担当支店に振り分ける マクロ

困っております。助けてください。。。

顧客一覧があります。

それぞれの町名で判断して、これぞれの顧客に担当支店を振り分けたいのですが、
if文で
○○町　だったら　０１支店
else if
××町　だったら 02支店

というふうに、ひたすら書いていくしかないのでしょうか？

対象住所は一つの市の数あるので、膨大です。

郵便番号で範囲をきめて、ふりわけていくのが一番かと思っているのですが・・・。

No.5 回答者： tom04 回答日時： 2014/12/29 20:13

No.4です。

＞ただ、○○町という住所の管轄はA支店とB支店両方という場合があります。
というコトですので・・・

前回と同じような方法ですが、Sheet2の表の作り方次第でコードは変わってきます。
Sheet2の表は↓の画像のような感じにしてみました。（最大2つの支店としています）

今回もSheet2の表はA列の文字数の昇順に並び替えをしておいてください。
（○○町と東○○町といった感じの町名を区別するため）

標準モジュールです。

Sub Sample2()
Dim i As Long, lastRow As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
With Worksheets("Sheet1")
Application.ScreenUpdating = False
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To wS.Cells(Rows.Count, "A").End(xlUp).Row
.Range("A1").AutoFilter field:=2, Criteria1:="*" & wS.Cells(i, "A") & "*"
If .Cells(Rows.Count, "A").End(xlUp).Row > 1 Then
Range(.Cells(2, "C"), .Cells(lastRow, "C")).SpecialCells(xlCellTypeVisible).Value = _
Trim(wS.Cells(i, "B") & " " & wS.Cells(i, "C"))
End If
Next i
.AutoFilterMode = False
Application.ScreenUpdating = True
End With
End Sub

こんな感じではどうでしょうか？m(_ _)m

この回答へのお礼

ありがとうございます！
販売店に対して、支店を複数割り当てる表づくりが大変ですが、、、やってみます。

ご親切に、ありがとうございました。

お礼日時：2014/12/30 10:51

No.4 回答者： tom04 回答日時： 2014/12/12 20:04

こんばんは！

一例です。
↓の画像のように別Sheet（Sheet2）のA・B列に一覧表を作成しておきます。
C2セルに
=LEN(A2)
という数式を入れ、フィルハンドルでダブルクリック！
そして、C列の「昇順」で並び替えを行っておきます。
（本来であれば、Sheet1の「空白セル」を抽出条件に加えれば「降順」でも良いのですが、
抽出条件を1列だけにしたため）

以上の下準備（この方が大変だと思いますが・・・）ができた上でのVBAです。

標準モジュールに↓のコードをコピー＆ペーストしてマクロを実行してみてください。

Sub Sample1()
Dim i As Long, lastRow As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
'▼Sheet2の2行目～A列最終行まで
For i = 2 To wS.Cells(Rows.Count, "A").End(xlUp).Row
'▼Sheet1のB列でフィルタを掛け、抽出条件をSheet2のi行A列の文字列が含まれているもの
.Range("A1").AutoFilter field:=2, Criteria1:="*" & wS.Cells(i, "A") & "*"
'▼表示されているデータが2行目以降にあれば、表示されているC列にSheet2のi行B列データを表示
If .Cells(Rows.Count, "A").End(xlUp).Row > 1 Then
Range(.Cells(2, "C"), .Cells(lastRow, "C")).SpecialCells(xlCellTypeVisible).Value = wS.Cells(i, "B")
End If
Next i
.AutoFilterMode = False
Application.ScreenUpdating = True
End With
End Sub

※　コード内に若干のコメントを記載していますので、
実状の配置に合わせて適宜修正してみてください。m(_ _)m

この回答へのお礼

ありがとうございました。さっそく作成しました。
VBAは無事実行できました。

ただ、○○町という住所の管轄はA支店とB支店両方という場合があります。

こういった場合は、両方の支店名を明記したいのですが、なにかいい方法はございますでしょうか？？

お礼日時：2014/12/29 13:26

No.3 回答者： Cheshire-Alice 回答日時： 2014/12/12 19:51

お邪魔します。

似たようなことを今やってたもので。多分質問者様よりデータ量ははるかに少ないはずですがｗ

webonerさんとusami33さんの回答を合わせる感じだといいんじゃないでしょうか？
私ならまず郵便番号と支店の対応シートを作ります。

111-0001　A支店
111-0003　A支店
111-1001　B支店
111-1002　A支店
111-1011　C支店

顧客リストシートに郵便番号はあるのでしょうから、顧客リストの郵便番号を検索値にして、郵便番号と支店の対応シートを作ります。

=vlookup([顧客リストシートの郵便番号のセル],[対応シート全体],[対応シートの支店名のセルが左から何個目か],false)
↑これを顧客リストシートの空いてるセルに1個入れたらそれをコピペ…で出てくるはずですが、この質問てExcelでよかったですか？

>郵便番号で範囲
usami33さんが教えてくれたCSVを斜め読みすると、範囲でやっちゃうと市区町村が入れ子になっちゃったりすると思うんで、範囲はやめといた方がいい気がします。

面倒でも↑で書いた「郵便番号と支店の対応シート」みたいなものは作っといた方が、確実な気がします。私もデータを斜め読みしただけなんで何とも言えませんが。

この回答への補足

ありがとうございました。さっそく作成しました。

ただ、○○町という住所の管轄はA支店とB支店両方という場合があります。

こういった場合は、両方の支店名を明記したいのですが、なにかいい方法はございますでしょうか？？

補足日時：2014/12/29 13:25

この回答へのお礼

ありがとうございます。大変参考になりました。
現在、支店の担当地区一覧を作成しているので、こちらが出来次第、つくります。
そもそも、担当地区一覧がなかったようで。。。。

お礼日時：2014/12/23 16:12

No.2 回答者： usami33 回答日時： 2014/12/12 17:34

郵便番号データは開示されているの知ってました？

http://www.post.japanpost.jp/zipcode/download.html
このデータをダウンロードして、対応表を作成してしまえば、検索や表示方法は簡単にできますよね。

No.1 回答者： weboner 回答日時： 2014/12/12 17:20

町名と支店の対応一覧表を作り

関数のVLOOKUPのような形式で読み込む

（と言うかExcelならVLOOKUPで処理したほうが早い）