كود يقوم بالترقيم فى حالة تساوى أخر خلية بالعمود لرقم معين

[محمد عفيفى أبو براء]

السلام عليكم .. لابد من التحية عند بدء اى مشاركة ,,بعد اذن حضراتكم ارجو المساعدة محتاج التعديل على الملف المرفق

كود يقوم بالترقيم التلقائى فى العمود (a) بشرط اخر حلية العمود ( t) لو كانت تساوى 1 يقوم بالترقيم ولو بتساوى اى شئ غير الواحد لا يتم الترقيم 

عنوان مخالف جداً .. تــــم تعديل وتغيير عنوان المشاركة ليعبر عن طلبك

فرز تعديل - Copy.xlsm

[محمد هشام.]

تفضل اخي

=IF($T4=1;1+MAX($A$3:$A3);"")

فرز تعديل - Copy.xlsm

[محمد عفيفى أبو براء]

اخى Mohamed Hicham

شكرا لك ولكنى محتاج كود علشا اشغلة مع الزر

[محمد هشام.]

تفضل اخي

Sub Test()
Dim c As Range, M2%, x%
Dim derlig As Long
derlig = Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
Range("a4:a1000").ClearContents
M2 = Range("T" & Rows.Count).End(xlUp).Row
For Each c In Range("T4:T" & M2)
If c.Value = 1 Then
x = x + 1
c.Offset(0, -19).Value = Format(x, "0")
End If
'في حالة الرغبة باستبدال المعادلات في الصف الأول بالكود يمكنك تفعيل هده السطور
'Range("a1") = Application.Sum(Range("a4:a" & derlig))
'Range("b1") = Application.Sum(Range("b4:b" & derlig))
'Range("c1") = Application.Sum(Range("c4:c" & derlig))
'Range("d1") = Application.Sum(Range("d4:d" & derlig))
'Range("e1") = Application.Sum(Range("e4:e" & derlig))
'Range("f1") = Application.Sum(Range("f4:f" & derlig))
'Range("g1") = Application.Sum(Range("g4:g" & derlig))
'Range("h1") = Application.Sum(Range("h4:h" & derlig))
'Range("i1") = Application.Sum(Range("i4:i" & derlig))
'Range("j1") = Application.Sum(Range("j4:j" & derlig))
'Range("k1") = Application.Sum(Range("k4:k" & derlig))
'Range("l1") = Application.Sum(Range("l4:l" & derlig))
'Range("m1") = Application.Sum(Range("m4:m" & derlig))
'Range("n1") = Application.Sum(Range("n4:n" & derlig))
'Range("o1") = Application.Sum(Range("o4:o" & derlig))
'Range("p1") = Application.Sum(Range("p4:p" & derlig))
'Range("q1") = Application.Sum(Range("q4:q" & derlig))
'Range("r1") = Application.Sum(Range("r4:r" & derlig))
Next
End Sub

فرز تعديل - MH.xlsm

[محمد عفيفى أبو براء]

السلام عليكم

تحياتى لحضرتك انا متشكر ليك جدا بصراحة ماشاء الله جزاكم الله خيرا

معلش طلب اخير فى الكود هل ممكن ان يكون الترقيم فى الصف التالى مثلا لو الشرط اللى هو واحد فى الخلية (t4) يكون الرقم المسلسل فى الخلية رقم (a5)

 

[محمد هشام.]

يمكنك اخي فعل دالك بتعديل بسيط في هدا السطر

c.Offset(0, -19).Value = Format(x, "0")

قم باضافة رقم 1 بدل الصفر

c.Offset(1, -19).Value = Format(x, "0")

 

[محمد عفيفى أبو براء]

السلام عليكم

استاذ Mohamed Hicham 

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

ومعلش عندى طلب اخر للملف انا اسف اذا كنت بشغلك بزيادة معلش

محتاج كود اخر يحدد اخر خلية بها بيانات فى العمود ( m ) واذا كان بها رقم 5 يظهر يوزر فورم ولو غير كدا يكمل معايا عادى بدون ما يظهر الفورم

فرز تعديل - Copy.xlsm

[محمد هشام.]

تفضل اخي

Sub FindLastRow_N°5()
    Dim LastRow As Long
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "M").End(xlUp)
        If .Cells(.Rows.Count, "M").End(xlUp).Value = 5 Then
          UserForm2.Show
    Else
        Exit Sub
    End If

    End With
End Sub

فرز تعديل - Copy.xlsm