Sub 指定製番のFINDNEXT抽出()
    
    Dim intRow As Integer
    Dim intRow2 As Integer
    Dim myRange As Range
    Dim strSeib As String
    Dim intKin As Variant
    Dim intR As Integer
    Dim Total As Integer
    
    Range("C4:C20").Select
    With Selection.Interior        '前回に色が付いていたら色なしにする。
        .Pattern = xlNone
    End With
    
    Range("C2:D2").ClearContents
    intRow = Range("C3").End(xlDown).Row
    Range("B4:D" & intRow).Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("C4:C" & 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
    
    Range("B2").Select
    strSeib = Range("B2") + "*"
    Con = 0
    Total = 0
    
    Set myRange = Worksheets("Sheet1").Range("C2:C" & intRow).Find(strSeib)
    If myRange Is Nothing Then GoTo JumpERR
    If myRange <> "" Then Con = Con + 1
    intRow2 = myRange.Row
    Range("C" & intRow2).Select
    
    With Selection.Interior               '選択した行を黄色にする。
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
    End With
    
    intKin = Worksheets("Sheet1").Range("B" & intRow2)
    Total = Total + intKin
    Range("C2").Value = Total
    Range("D2").Value = "製番数" & Con
    
    Do
      Set myRange = Worksheets("Sheet1").Range("C2:C" & intRow).FindNext(myRange)
      If myRange <> "" Then Con = Con + 1
      intR = myRange.Row
      If intRow2 = intR Then GoTo JumpEnd
      
      Range("C" & intR).Select
      With Selection.Interior               '選択した行を黄色にする。
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
      End With
      
      intKin = Worksheets("Sheet1").Range("B" & intR)
      Total = Total + intKin
      
      Range("C2").Value = Total
      Range("D2").Value = "製番数" & Con
      
    Loop
    GoTo JumpEnd
           
JumpERR:
    intKin = "データなし"
    Range("D2").Value = intKin
JumpEnd:
    Set myRange = Nothing
End Sub