اريد عند اضافة نفس الصنف يتم زيادة الكمية

[هشام جمال الدين]

 اريد عند اضافة نفس الصنف يتم زيادة الكمية وليس تكرار اسم الصنف وشكرا

برنامج.xlsb

[lionheart]

Sub ADDITEM()
    Dim x, itemRow As Long, availRow As Long
    With Sheet2
        If .Range("K3").Value = Empty Then Exit Sub
        Application.EnableEvents = False
            itemRow = Range("K3").Value
            availRow = Range("F999").End(xlUp).Row + 1
            Range("B4").Value = Sheet4.Range("B" & itemRow).Value
            Range("D5").Value = Sheet4.Range("D" & itemRow).Value
            Range("B5").Value = 1
            Range("F" & availRow).Value = Range("B4").Value
            Range("G" & availRow).Value = Range("B5").Value
            Range("H" & availRow).Value = Range("D5").Value
            Range("I" & availRow).Value = "=H" & availRow & "*G" & availRow
        Application.EnableEvents = True
    End With
End Sub

 

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim x, xx, RecptRow As Long
    If Not Intersect(Target, Range("B3")) Is Nothing And Range("B3").Value <> Empty Then
        xx = Application.Match(Range("B3"), Sheet4.Columns(1), 0)
        If Not IsError(xx) Then Range("B4").Value = Sheet4.Cells(xx, 2).Value
        x = Application.Match(Range("B4").Value, Columns(6), 0)
        If IsError(x) Then ADDITEM
    End If
    If Not Intersect(Target, Range("B5,D5")) Is Nothing And Range("K2").Value = False And Range("K1").Value <> Empty Then
        x = Application.Match(Range("B4").Value, Columns(6), 0)
        If IsError(x) Then
            RecptRow = IIf(Range("K5").Value = 0, Range("K1").Value, Range("K5").Value)
        Else
            RecptRow = x
        End If
        If Not Intersect(Target, Range("B5")) Is Nothing Then Range("G" & RecptRow).Value = Val(Range("G" & RecptRow).Value) + Target.Value
        If Not Intersect(Target, Range("D5")) Is Nothing Then Range("H" & RecptRow).Value = Val(Range("H" & RecptRow).Value) + Target.Value
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("f13:i999")) Is Nothing And Range("f" & Target.Row).Value <> Empty Then
Range("K1").Value = Target.Row
Range("K2").Value = True
Range("b4").Value = Range("F" & Target.Row).Value
Range("B5").Value = Range("G" & Target.Row).Value
Range("D5").Value = Range("H" & Target.Row).Value
Range("K2").Value = False
End If
End Sub