VBAノック17本目：重複削除（ユニーク化）

Excel&VBA解説サイト「エクセルの神髄」様出題の問題集、
「VBA100本ノック」に対する私の回答と解説のページです。

100本ノックの出題リストはこちらから
excel-ubara.com

出題：重複削除（ユニーク化
ソースコード
解説

出題：重複削除（ユニーク化

#VBA100本ノック 17本目
画像1のように部・課・氏名の「社員」シートがあります。
このデータを基に、画像2のように部・課マスタを作成してください。
※部・課でユニーク化するという事ことです。
シート「部・課マスタ」は存在している前提で構いません。
※マスタなのでコード順にしてください。

社員データ
部課マスタ

◇ 出題ページはこちら

ソースコード

定義モジュール

Option Explicit

' 社員
Public Const R1st社員 = 2
Public Const C1st社員 = 1
Public Enum CNo社員
    社員コード = C1st社員
    社員氏名
    部コード
    課コード
    部名称
    課名称
End Enum
Public Const CLast社員 = CNo社員.課名称

' 部課マスタ
Public Const R1st部課マスタ = 2
Public Const C1st部課マスタ = 1
Public Enum CNo部課マスタ
    部コード = C1st部課マスタ
    課コード
    部名称
    課名称
End Enum
Public Const CLast部課マスタ = CNo部課マスタ.課名称

メインモジュール

Option Explicit

' 社員
Public Const R1st社員 = 2
Public Const C1st社員 = 1
Public Enum CNo社員
    社員コード = C1st社員
    社員氏名
    部コード
    課コード
    部名称
    課名称
End Enum
Public Const CLast社員 = CNo社員.課名称

' 部課マスタ
Public Const R1st部課マスタ = 2
Public Const C1st部課マスタ = 1
Public Enum CNo部課マスタ
    部コード = C1st部課マスタ
    課コード
    部名称
    課名称
End Enum
Public Const CLast部課マスタ = CNo部課マスタ.課名称

汎用関数モジュール

Option Explicit

' 指定行より下の削除
' 参考：https://www.limecode.jp/entry/utility/delete-rows-below-to-last
Sub 指定行より下をすべて削除する(対象シート As Worksheet, 指定行 As Long)
    With 対象シート
    
        Call フィルターをクリアする(対象シート)
        
        .Range(.Rows(指定行), .Rows(.Rows.Count)).Delete
        
    End With
End Sub

' フィルターのクリア
' ◆ ブログ未掲載
Sub フィルターをクリアする(対象シート As Worksheet)
    If 対象シート.AutoFilterMode = True Then
        If 対象シート.AutoFilter.FilterMode = True Then
            対象シート.AutoFilter.ShowAllData
        End If
    End If
End Sub


' 最終行の取得
' 参考：https://www.limecode.jp/entry/library/get-lastrow-lastcolumn
Function Get最終行(指定オブジェクト As Variant, Optional ByVal C As Long = -1) As Long

    ' 渡されたオブジェクトからセル範囲を取得
    Dim 対象セル範囲 As Range
    Select Case TypeName(指定オブジェクト)
    Case "Range"
        If 指定オブジェクト.Cells.CountLarge = 1 Then ' 単独セルにはCurrentRegionを取る
            Set 対象セル範囲 = 指定オブジェクト.CurrentRegion
        Else
            Set 対象セル範囲 = 指定オブジェクト
        End If
    Case "Worksheet"
        Set 対象セル範囲 = 指定オブジェクト.UsedRange
    Case "AutoFilter", "ListObject"
        Set 対象セル範囲 = 指定オブジェクト.Range
    Case Else
        Err.Raise 1000, , "対象外のオブジェクト「" & TypeName(指定オブジェクト) & "」が指定されました。"
    End Select

    ' エリアの最終行を取得
    Get最終行 = 対象セル範囲.Rows.Count + 対象セル範囲.Row - 1

    ' 列が指定されていればその列の入力最終行を取得
    If C <> -1 Then
        Do While 対象セル範囲.Worksheet.Cells(Get最終行, C) = ""
            Get最終行 = Get最終行 - 1
            If Get最終行 < 対象セル範囲.Row Then
                Get最終行 = 0
                Exit Function
            End If
        Loop
    End If

End Function