اختيار اسم الاصناف بناء على اسم المجموعة

[elsedik]

عند اختيار اسم المجموعة يتم اظهار اسماء اصناف المجموعة بدون تكرار فى شيت 2 

 

مرفق ملف 

اسم المجموعة.rar

[طارق محمود]

السلام عليكم

تفضل المرفق

اسم المجموعة.rar

[elsedik]

جزاك الله كل خير  

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

أستاذي ومعلمي وأخي في الله الباشمهندس طارق

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

في هذا السطر

[A6:D666].Delete Shift:=xlUp

لم يتم حذف صفوف النطاق الذي سيتم إدراج النتائج فيه .. أليس من الممكن أن نستخدم السطر بهذا الشكل

[A6:D666].ClearContents

في سطر آخر يتم جلب البيانات ابتداءً من الصف الثالث ثم في الكود تقوم بحذف الجزء الخاص بالصف الذي تم جلبه

Union(.Range("A3:A" & nR), .Range("C3:C" & nR), .Range("G3:G" & nR)).Copy [A6]

[A6:D6].Delete Shift:=xlUp

أليس من الممكن الاستغناء عن سطر حذف الصف السادس في ورقة النتائج ، أقصد سطر الكود المدرج أعلى كلامي

 

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

Union(.Range("A4:A" & nR), .Range("C4:C" & nR), .Range("G4:G" & nR)).Copy [A6]

أمر آخر لم تم استخدام متغير LR في حين أنه يمكن عمل فلترة للبيانات باستخدام الصف الأول فقط في البيانات دون اللجوء إلى معرفة الصف الأخير .. بهذا يمكن الاستغناء عن المتغير LR

 

أمر آخر الجملة الأخيرة في الكود لم لم تضمنها ما بين الجملة With و End With

 

ليصبح الكود النهائي بهذا الشكل :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim nR As Long
    If Intersect(Target, [C3]) Is Nothing Then Exit Sub
    
    slct = [C3]
    [A6:D666].ClearContents
    
    With Sheets("Sheet1")
       .Range("A3:G3").AutoFilter Field:=2, Criteria1:=slct
        nR = .[A9999].End(xlUp).Row
       Union(.Range("A4:A" & nR), .Range("C4:C" & nR), .Range("G4:G" & nR)).Copy [A6]
       .AutoFilterMode = False
    End With
End Sub

عذراً معلمي إن كنت أثقلت عليك .. فقط نريد أن نتعلم منك ومن خبراتك الرائعة

تقبل ودي وحبي وتحياتي واحترامي

[سليم حاصبيا]

بعد إذن الاستاذ طارق 

حل آخر بواسطة العادلات

 

salim اسم المجموعة.rar

[طارق محمود]

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

أستاذي ومعلمي وأخي في الله الباشمهندس طارق

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

في هذا السطر

[A6:D666].Delete Shift:=xlUp

لم يتم حذف صفوف النطاق الذي سيتم إدراج النتائج فيه .. أليس من الممكن أن نستخدم السطر بهذا الشكل

[A6:D666].ClearContents

أصبت ، فعلا هذا الأمر أفضل من الأمر اللي في الكود
 

في سطر آخر يتم جلب البيانات ابتداءً من الصف الثالث ثم في الكود تقوم بحذف الجزء الخاص بالصف الذي تم جلبه

Union(.Range("A3:A" & nR), .Range("C3:C" & nR), .Range("G3:G" & nR)).Copy [A6]

[A6:D6].Delete Shift:=xlUp

أليس من الممكن الاستغناء عن سطر حذف الصف السادس في ورقة النتائج ، أقصد سطر الكود المدرج أعلى كلامي

 

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

Union(.Range("A4:A" & nR), .Range("C4:C" & nR), .Range("G4:G" & nR)).Copy [A6]

لا ليس هذا دقيقا،
قد يكون ناتج الفلتر لايحتوي السطر الرابع مثلا

 

أمر آخر لم تم استخدام متغير LR في حين أنه يمكن عمل فلترة للبيانات باستخدام الصف الأول فقط في البيانات دون اللجوء إلى معرفة الصف الأخير .. بهذا يمكن الاستغناء عن المتغير LR

نعم ممكن هذا ولكن هذا قد يحدث خطأ إذا كان عندك سطر أو أكثر فارغين تماما 
إستخدام السطر الأول لايتضمن مابعد الأسطر الفارغة

 

أمر آخر الجملة الأخيرة في الكود لم لم تضمنها ما بين الجملة With و End With

 

ليصبح الكود النهائي بهذا الشكل :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim nR As Long
    If Intersect(Target, [C3]) Is Nothing Then Exit Sub
    
    slct = [C3]
    [A6:D666].ClearContents
    
    With Sheets("Sheet1")
       .Range("A3:G3").AutoFilter Field:=2, Criteria1:=slct
        nR = .[A9999].End(xlUp).Row
       Union(.Range("A4:A" & nR), .Range("C4:C" & nR), .Range("G4:G" & nR)).Copy [A6]
       .AutoFilterMode = False
    End With
End Sub
 

نعم هذه أجمل

لك مني كل الحب والتقدير