自分用です。
番号に対応した地区名を住所録にいれる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

 

おすすめの記事