كيف اقوم باضافة جديده وسابقه على جدول

[atob]

السلام عليكم ورحمة الله وبركاته

اخواني الاعزاء مساكم الله بالف خير

لدي طلب وهو كيف اضيف قيم جديده على قيم سابقه ان كانت جديده يضيف كامل البيانات

وان كانت موجوده سابقا فأنه يضيف العدد فقط

والملف المرفق يوضح اكثر عن طلبي

واخيرا اشكركم جزيل الشكر

اضافه.rar

[atob]

اتمنى منكم مساعدتي في هذا الطلب وشكرا لكم

[أبو حنــــين]

جرب اخي المرفق اعتقد انه يعمل

اضافه تعديل.rar

[atob]

اشكرك جزيل الشكر اخي ابو حنين

طبع الملف لم يعمل

[عبدالله باقشير]

السلام عليكم

Private Sub CommandButton1_Click()

Dim iNx

Dim Last As Long

'''''''''''''''''''''''

If Len(Trim(Range("C6"))) = 0 Then Exit Sub

'''''''''''''''''''''''

iNx = Me.Evaluate("MATCH(C6,H:H,0)")

'''''''''''''''''''''''

Select Case IsError(iNx)

    Case True

        If MsgBox("هل تريد اضافة الكتاب الجديد" & vbCr & Range("C6").Value, vbYesNo + vbMsgBoxRight) = vbYes Then

            Last = Range("H" & Rows.Count).End(xlUp).Row + 1

            Range("H" & Last).Resize(1, 4).Value = Range("C6").Resize(1, 4).Value

            MsgBox "تم بحمد الله "

        End If

    '''''''''''''''

    Case False

        If MsgBox("هل تريد اضافة العدد " & vbCr & Range("C6").Value, vbYesNo + vbMsgBoxRight) = vbYes Then

            Last = iNx

            Range("J" & Last).Value = Val(Range("J" & Last)) + Val(Range("E6"))

            MsgBox "تم بحمد الله "

        End If

End Select

End Sub


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim LastRow As Long

On Error GoTo 1

LastRow = Range("C" & Rows.Count).End(xlUp).Row

If Not Application.Intersect(Target, Range("C9", Cells(LastRow, "C"))) Is Nothing Then

    Application.EnableEvents = False

    Cancel = True

    Range("C6").Resize(1, 4).Value = Target.Resize(1, 4).Value

1:

    Application.EnableEvents = True

End If

End Sub


Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = Range("C6").Address Then

    kh_AdFilter

    Me.CommandButton1.Enabled = Len(Trim(Range("C6")))

End If

End Sub


Private Sub kh_AdFilter()

Dim RngFilte As Range

Dim LastRow As Long

LastRow = Range("H" & Rows.Count).End(xlUp).Row


Range("H9", Cells(LastRow, "K")).AdvancedFilter xlFilterCopy, Range("M1:M2"), Range("C9:F9")

End Sub

شاهد المرفق

2003-2007

بحث واضافة.rar

[atob]

اشكركم الجميع انت اخي ابو حنين وانت اخي عبدالله على مجهوداتكم وردودكم المفيده

فلن استطيع ان اجازيكم الا بالدعاء لكم بالتوفيق

[atob]

اخواني الاعزاء اريد تعديل بسيط في الكود اذا امكن

وهو اجعل الترتيب يبقى في نفس الجدول

الملف المرفق يوضح اكثربحث واضافة2.rar

[عبدالله باقشير]

السلام عليكم

شاهد المرفق

2003-2007

بحث واضافة2.rar

[atob]

هذا هو المطلوب وزياده

واسأل الله العلي العظيم ان يوفقك في دنياك واخرتك

وان يرزقك على قد نيتك ومساعدتك للاخرين