Sub 製番抽出と金額合計() Dim St As String Dim M As Integer Dim intRow As Integer Dim strSeib As String Dim S As Integer Dim St2 As String Dim Tot As Integer Dim Total As Integer St = Range("B2").Value Range("B2").Value = RTrim(St) strSeib = Range("B2") M = Len(Range("B2")) intRow = Range("B3").End(xlDown).Row Total = 0 For i = 4 To intRow S = Len(Range("C" & i)) St2 = Range("C" & i) Range("C" & i).Value = RTrim(St2) D1 = Left(Range("C" & i), M) If strSeib = Left(Range("C" & i), M) Then Tot = Range("B" & i) Total = Total + Tot End If Next End Sub