自分用です。
番号に対応した地区名を住所録にいれるVBAコードです。
Sub 地区名を住所表に追加()
Dim 元表 As Worksheet
Dim 住所表 As Worksheet
Dim 対応表 As Object
Dim 書き込み列 As Long
Dim 行番号 As Long
Dim 対象支店番号 As String
Dim 最終行 As Long
Set 元表 = ThisWorkbook.Sheets("Sheet1")
Set 住所表 = ThisWorkbook.Sheets("Sheet2")
' 関数から対応表を取得
Set 対応表 = 支店地区対応表を取得(元表)
' 書き込み列の決定(4行目の最右+1列)
書き込み列 = 住所表.Cells(4, 住所表.Columns.Count).End(xlToLeft).Column + 1
' 地区名を住所表に書き込む
最終行 = 住所表.Cells(住所表.Rows.Count, 1).End(xlUp).Row
For 行番号 = 5 To 最終行
対象支店番号 = 住所表.Cells(行番号, 1).Value
If 対応表.exists(対象支店番号) Then
住所表.Cells(行番号, 書き込み列).Value = 対応表(対象支店番号)
End If
Next 行番号
End Sub
Function 支店地区対応表を取得(元表 As Worksheet) As Object
Dim 対応表 As Object
Set 対応表 = CreateObject("Scripting.Dictionary")
Dim 最終行 As Long
Dim 行番号 As Long
Dim 支店番号 As String
Dim 地区名 As String
最終行 = 元表.Cells(元表.Rows.Count, 1).End(xlUp).Row
For 行番号 = 2 To 最終行
支店番号 = 元表.Cells(行番号, 1).Value
地区名 = 元表.Cells(行番号, 2).Value
対応表(支店番号) = 地区名
Next 行番号
Set 支店地区対応表を取得 = 対応表
End Function