طلب كتابة معادلة بشكل صحيح في حدث الورقة و ليس الخلية

[زياد عبد الجليل]

السلام على جميع الاساتذة الافاضل اما بعد

عندي استفسار حول كيفية كتابة معادلة في حدث الورقة تقوم بعمل ترقيم تلقائي حيث بمجرد كتابة اي شيء في خلية Bمثلا تترقم الخلية A بالرقم 1 و بمجرد الكتابة في الخلية التي تليها تترقم الخلية الموالية و هكذا، هاهي المعادلة ارديها في حدث الورقة و ليس في الخلية مع الترقيم مثلا من الخلية A9الى غاية A40 و لكم مني كل الشكر و التقدير

 

((SI(C9="";"";SOUS.TOTAL(3;C$6:C9=

[ياسر خليل أبو البراء]

وعليكم السلام أخي الكريم زياد

أفضل إرفاق ملف للعمل عليه وتوفيراً للوقت ولتتضح الصورة أكثر ..

[زياد عبد الجليل]

شكرا لك استاذ ياسر اليك الملف فيه المطلوب بالضبط تحياتي الخالصة للجميع

معادلة في حدث الورقة للترقيم التسلسلي.rar

[شوقي ربيع]

السلام عليكم

جرب هذا في حدث Change الورقة

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("B9:B50"), Target) Is Nothing Then
        If Range("a" & Target.Row - 1) <> "" Then Range("a" & Target.Row) = Target.Row - 8
    End If
End Sub

 

معادلة في حدث الورقة للترقيم التسلسلي.rar

[ياسر خليل أبو البراء]

جرب الكود التالي عله يفي بالغرض

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Rng As Range, LR As Integer
    
    If Target.Column = 3 Then
        LR = Cells(Rows.Count, "C").End(xlUp).Row
        Set Rng = Range(Cells(9, 1), Cells(LR, 1))
        
        Rng.Formula = "=IF(C9="""","""",SUBTOTAL(3,C$9:C9))"
        Rng.Value = Rng.Value
    End If
End Sub

 

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

[زياد عبد الجليل]

انا جد مسرور على مرور عملاقين من عمالقة الاكسيل على موضوعي واشكر الاستاذين ربيع و ياسر على ايجابتهما الشافية الكافية ولكن يبقى خلل فقط عند ازالة سطر اود ان يعاد الترتيب اليا مثلا اذا كان هناك قيم من 1 الى 50 عند ازالة السطر 30 مثلا يعاد الترقيم اليا من 1 الى 49 ...حتى وان لم تجدو حل لهذا الاشكال   فتبقى هذه لاكواد والله غاية في الدقة و الروعة وفرحتي بمروركم تكفيني

[شوقي ربيع]

دائما هناك حل مع الاكسل

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lr As Long: Lr = Cells(Rows.Count, "B").End(xlUp).Row
Dim myRange As Range
Dim cell As Range
Set myRange = Range("B9:B" & Lr)
    If Not Intersect(myRange, Target) Is Nothing Then
        For Each cell In myRange
        Range("a" & cell.Row) = cell.Row - 8
        Next cell
    End If
End Sub

 

[ياسر خليل أبو البراء]

أخي الكريم زياد

يكفي أن تضيف سطر يمسح النطاق بدايةً من الخلية A9 وإلى نهاية النطاق بهذا الشكل

Rng.ClearContents

قبل سطر وضع المعادلة

[زياد عبد الجليل]

شكرا اخوتي ولكن استاذ ربيع بعد عمل delet-supprimer لكل الخلايا تظهر قيم بالناقص في اعلى العمود هل يمكن ازالتها مثلا -1   -2   -3  وشكرا اساتذتي

[عبدالسلام ابوالعوافي]

افتقدناك استاذ ياسر .. اليوم دبت الحياة في المنتدى من جديد ^_^

كود اخر لاثراء الموضوع 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim i As Integer
    For i = 9 To 1000
        If Cells(i, 2) & "" = "" Then Exit For
        Cells(i, 1) = i - 8
    Next
End Sub

 

[omar elhosseini]

 

الاخ زياد777

حسما للموضوع

شاهد المرفق

 

Omar_1.rar

[زياد عبد الجليل]

شكرا اخي عمر تسلم الايادي

[زياد عبد الجليل]

السلام على جميع لاخوة الافاضل ان امكن اخوتي لقد وجدت حل لها الاشكال من خلالكم و من خلال اكوادكم الرائعة واعمالكم الممتازة ولكن عندي طلب فيما يخص هذا الموضوع وهو تعديل على هذه الاكواد وجعلها مثلا بمجرد الكتابة في خلية c9 ترقم الخلية a9 وفي نفس الوقت تكتب عبارة في الخليةf9 مثلا :منتدى العمالقة- اوفيسنا وهكذا مع باقي الخلايا يعني ليس فقط f9 ...اعلم ان لا صعب يصعب على العمالقة .

و الشكر موصول الى كل من ساهم معنا في هذا الموضوع.تقبلو مني اصدق مشاعر الحب 

تم تعديل أغسطس 15, 2016 بواسطه زياد777

[ياسر خليل أبو البراء]

جرب التعديل التالي عله يفي بالغرض

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range, LR As Integer

    If Target.Column = 3 And Target.Row > 8 Then
        Application.EnableEvents = False
            If Not IsEmpty(Target) Then
                LR = Cells(Rows.Count, "C").End(xlUp).Row
                Set Rng = Range(Cells(9, 1), Cells(LR, 1))
    
                With Rng
                    .ClearContents
                    .Formula = "=IF(C9="""","""",SUBTOTAL(3,C$9:C9))"
                    .Value = Rng.Value
                End With
    
                Target.Offset(, 3).Value = "زياد777"
            End If
        Application.EnableEvents = True
    End If
End Sub

تقبل تحياتي

 

[زياد عبد الجليل]

شكرا  يا استاذ ياسر  عظمة على عظمة  شكرا جزيلا اخي

[زياد عبد الجليل]

السلام عليكم استاذ ياسر ولكن عند عمل delet لاي سطر يبقى اختلال التسلسل فيجب الذهاب عند الخلية التي يبدأ من اختلال التسلسل و عمل عليها كليك حتى يعاد التسلسل في الارقام كيف اجعل هذا الكود اكثر خفة اي يعمل بدون ان نلمس الورقة او عمل كليك عليها ....انا اقصد  الكود الاخير في هذا الموضوع للاستاذ القدير ياسر...ولكم مني خاص عبارات الشكر و الامتنان.

[ياسر خليل أبو البراء]

لإحداث تغيير بشكل تلقائي يلزم حدث .. والحدث المشهور في أوراق العمل إما حدث تغيير في الخلايا أو تحديد الخلايا ..

لا يمكن أن يتم التنفيذ وتفعيل الحدث بشكل مباشر .. لابد من وجود قرينة للحدث حتى ينفذ الكود

[زياد عبد الجليل]

استاذ ياسر هذا الكود للاستاذ ربيع شوقي يعمل بشكل جيد و يقوم بالمطلوب لو تفضلت و اضفت فقط 

شرط وضغ العبارة في الخلية f ...ولك مني جزيل الشكر

(Private Sub Worksheet_Change(ByVal Target As Range
Dim Lr As Long: Lr = Cells(Rows.Count, "c").End(xlUp).Row
Dim myRange As Range
Dim cell As Range
(Set myRange = Range("c9:c" & Lr
    If Not Intersect(myRange, Target) Is Nothing Then
        For Each cell In myRange
        Range("a" & cell.Row) = cell.Row - 8
        Next cell
    End If

End Sub

هاهي العبارة

   Target.Offset(, 3).Value = "زياد777"

[ياسر خليل أبو البراء]

ضع العبارة بعد الحلقة التكرارية وجرب بنفسك ..!!

[زياد عبد الجليل]

شكرا استاذ ياسر العملية ناجحة 100/100

[ياسر خليل أبو البراء]

4 ساعات مضت, زياد777 said:

شكرا استاذ ياسر العملية ناجحة 100/100

مين الجراح اللي عمل العملية ؟؟ أكيد إنت !!

أنا عطيتك المشرط وإنت قمت بالعملية .. تسلم يا دكتور زيزو