■

Sub 職場名と在庫数を転記する()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lastRow1 As Long
    Dim lastRow2 As Long
    Dim i As Long, j As Long
    Dim foundMatch As Boolean
    Dim maxStock As Long
    Dim maxStockLocation As String
    Dim secondMaxStock As Long
    Dim secondMaxStockLocation As String
    Dim thirdMaxStock As Long
    Dim thirdMaxStockLocation As String
    
    ' シート1とシート2を設定
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    
    ' シート1の最終行を取得
    lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    
    ' シート1の各行に対して処理を行う
    For i = 2 To lastRow1 ' ヘッダーを含まないため、2から始める
        ' シート1のアイテム部番と寸法を取得
        itemNumber = ws1.Cells(i, "A").Value
        dimension = ws1.Cells(i, "B").Value
        
        ' 初期化
        foundMatch = False
        maxStock = 0
        maxStockLocation = ""
        secondMaxStock = 0
        secondMaxStockLocation = ""
        thirdMaxStock = 0
        thirdMaxStockLocation = ""
        
        ' シート2の最終行を取得
        lastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
        
        ' シート2をループして合致するアイテム部番を探す
        For j = 2 To lastRow2 ' ヘッダーを含まないため、2から始める
            If ws2.Cells(j, "A").Value = itemNumber And ws2.Cells(j, "B").Value = dimension Then
                ' アイテム部番と寸法が一致する場合
                stock = ws2.Cells(j, "D").Value
                location = ws2.Cells(j, "C").Value
                
                ' 在庫数が現在の最大在庫数より大きい場合、最大在庫数と職場名を更新
                If stock >= maxStock Then
                    thirdMaxStock = secondMaxStock
                    thirdMaxStockLocation = secondMaxStockLocation
                    secondMaxStock = maxStock
                    secondMaxStockLocation = maxStockLocation
                    maxStock = stock
                    maxStockLocation = location
                ElseIf stock >= secondMaxStock Then
                    thirdMaxStock = secondMaxStock
                    thirdMaxStockLocation = secondMaxStockLocation
                    secondMaxStock = stock
                    secondMaxStockLocation = location
                ElseIf stock >= thirdMaxStock Then
                    thirdMaxStock = stock
                    thirdMaxStockLocation = location
                End If
                
                foundMatch = True
            End If
        Next j
        
        ' 合致するアイテム部番が見つかった場合、転記する
        If foundMatch Then
            ws1.Cells(i, "C").Value = maxStockLocation
            ws1.Cells(i, "D").Value = maxStock
            ws1.Cells(i, "E").Value = secondMaxStockLocation
            ws1.Cells(i, "F").Value = secondMaxStock
            ws1.Cells(i, "G").Value = thirdMaxStockLocation
            ws1.Cells(i, "H").Value = thirdMaxStock
        Else
            ' 合致するアイテム部番が見つからなかった場合、エラーメッセージを表示
            MsgBox "アイテム部番 " & itemNumber & " に対する合致するデータが見つかりませんでした。", vbExclamation
            ' 該当行のa列とB列を黄色にする
            ws1.Range("A" & i & ":B" & i).Interior.Color = RGB(255, 255, 0)
        End If
    Next i
End Sub