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

質問

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

顧客一覧があります。

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

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

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

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

回答No.4

tom04

こんばんは！

一例です。
↓の画像のように別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支店両方という場合があります。

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