Sub 指定製番の完全一致FIND抽出()
    
    Dim intRow As Integer
    Dim myRange As Range
    Dim strSeib As String
    Dim intDay As Variant
    Dim intR As Integer
    
    Range("C4:C20").Select
    With Selection.Interior        '前回に色が付いていたら色なしにする。
        .Pattern = xlNone
    End With
    
    Range("C2:D2").ClearContents
    intRow = Range("C3").End(xlDown).Row
    strSeib = Range("B2")
    
    Range("B4:D" & intRow).Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("B4:B" & intRow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("B4:D" & intRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Set myRange = Worksheets("Sheet1").Range("C2:D" & intRow).Find(what:=strSeib, LookAt:=xlWhole)
    If myRange Is Nothing Then GoTo JumpERR
    
    intR = myRange.Row
    intDay = Worksheets("Sheet1").Range("D" & intR)
    Range("D2").Value = intDay
    Range("C2").Value = Range("B" & intR)
    Range("C" & intR).Select
    
    With Selection.Interior               '選択した行を黄色にする。
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
    End With
    
    GoTo JumpEnd
    
JumpERR:
    Range("D2").Value = "データなし"
JumpEnd:
    
    Set myRange = Nothing
        
End Sub