■

Option Explicit
Sub 最短納期抽出()
    Dim wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim lastRowSource As Long
    Dim lastRowDest As Long
    Dim sourceRange As Range
    Dim destRange As Range
    Dim dict As Object
    Dim key As Variant
    Dim rowNum As Long
    
    ' ソースシートとデスティネーションシートを設定
    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    Set wsDestination = ThisWorkbook.Sheets("Sheet2")
    
    ' ソースシートの最終行を取得
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    ' デスティネーションシートの最終行を取得
    lastRowDest = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row
    
    ' ソースシートから型番1と型番2をキーにしてデータを抽出
    Set dict = CreateObject("Scripting.Dictionary")
    For rowNum = 2 To lastRowSource ' ヘッダー行をスキップ
        key = wsSource.Cells(rowNum, 1).Value & "|" & wsSource.Cells(rowNum, 2).Value ' 型番1と型番2をキーにする
        If Not dict.exists(key) Then
            dict.Add key, wsSource.Cells(rowNum, 3).Value ' 納期を追加
        End If
    Next rowNum
    
    ' デスティネーションシートに抽出したデータを出力
    Set destRange = wsDestination.Range("A2") ' 出力先のセルを設定
    For Each key In dict.keys
        destRange.Value = Split(key, "|")(0) ' 型番1
        destRange.Offset(0, 1).Value = Split(key, "|")(1) ' 型番2
        destRange.Offset(0, 2).Value = dict(key) ' 納期
        Set destRange = destRange.Offset(1, 0) ' 次の行へ移動
    Next key
End Sub
Sub 後工程の最短納期抽出2()
    Dim wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim lastRowSource As Long
    Dim lastRowDest As Long
    Dim sourceRange As Range
    Dim destRange As Range
    Dim dict As Object
    Dim key As Variant
    Dim rowNum As Long
    
    ' ソースシートとデスティネーションシートを設定
    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    Set wsDestination = ThisWorkbook.Sheets("Sheet2")
    
    ' ソースシートの最終行を取得
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    ' デスティネーションシートの最終行を取得
    lastRowDest = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row
    
    ' ソースシートから型番1と型番2をキーにしてデータを抽出
    Set dict = CreateObject("Scripting.Dictionary")
    For rowNum = 2 To lastRowSource ' ヘッダー行をスキップ
        key = wsSource.Cells(rowNum, 1).Value & "|" & wsSource.Cells(rowNum, 2).Text & "|" & wsSource.Cells(rowNum, 5).Value ' 型番1、型番2、後工程をキーにする
        If Not dict.exists(key) Then
            dict.Add key, wsSource.Cells(rowNum, 3).Value ' 納期を追加
        End If
    Next rowNum
    
    ' デスティネーションシートに抽出したデータを出力
    Set destRange = wsDestination.Range("A2") ' 出力先のセルを設定
    For Each key In dict.keys
        destRange.Value = Split(key, "|")(0) ' 型番1
        destRange.Offset(0, 1).Value = Split(key, "|")(1) ' 型番2
        destRange.Offset(0, 2).Value = Split(key, "|")(2) ' 後工程
        destRange.Offset(0, 3).Value = dict(key) ' 納期
        Set destRange = destRange.Offset(1, 0) ' 次の行へ移動
    Next key
End Sub