كود عمل قائمة منسدلة بأسماء الشيتات

[yara ahmed]

اخواتى وحبايبى

احتاج كود  لعمل قائمة منسدلة بدا من E3:e50

باسماء الشيت بدا من الشيت رقم 6 اما اول 5 شيت لاتكون فى القائمة

انا اضطر لعمل القوائم بشكل يدوى بس بعد اضافة شيت جديد بتاخد وقت منى

مش عايزة ترتيب ابجدى عايزة بترتيب الشيت بدا من الشيت السادس والشرح فى الشيت

شاكرة فضلكم

قائمة منسدلة .xlsm

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

في اي شبت تريدين هذه القائمة

اذا كان في شيت الاعتماد هذا الكود

او اختاري اي شيت اخر من خلال الكود

Option Explicit
Sub data_val()
 Dim My_sh As Worksheet
 Dim Sh As Worksheet
 Dim Ar()
 Dim x%

 Set My_sh = Sheets("الاعتماد")
 My_sh.Range("J3").CurrentRegion.ClearContents
 For Each Sh In Worksheets
   If Sh.Name Like "المواد*" Or _
      Sh.Name Like "الاعتماد*" Then
    Else
      ReDim Preserve Ar(x)
      Ar(x) = Sh.Name
      x = x + 1
   End If
   Next
 If x > 0 Then
    My_sh.Range("J3").Resize(UBound(Ar) + 1) = _
    Application.Transpose(Ar)
      With My_sh.Range("E3").Resize(49).Validation
      .Delete
      .Add 3, Formula1:=Join(Ar, ",")
      End With
 End If
 Set My_sh = Nothing: Set Sh = Nothing: Erase Ar
 
End Sub

المبف مرفق

yara_data_val.xlsm

[yara ahmed]

اخويا الغالى لقلبى استاذ سليم العبقري

فى شيت الاعتماد

مشكور

[yara ahmed]

سليم حاصبيا انت سكر وعسل وقمر وشربات وكريمة بالمكسرات 

بس لو عندى اسماء الشيت 5 بخلاف مواد واعتما اغير هذا الجزء

  If Sh.Name Like "المواد*" Or _
      Sh.Name Like "الاعتماد*" Then

مع اضافة or

يعنلى لو شيت اسمه يارا وشيت اسمه سليم وشيت اسمه ماجد

مشكوووووووووووووووووووور ياباشا الاكسيل

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

ممكن هذا الشيء

لكن اذا كانت الشبتات كثيرة الأفضل استعمال  Array  تحتوي اسماء الشيتات التي لا تريدينها

هذا الكود مثلاً

Sub data_val_2()
 Dim My_sh As Worksheet
 Dim Sh As Worksheet
 Dim Ar(), Ar_sheets
 Dim x%
Ar_sheets = Array("المواد1", "المواد2", "المواد3", _
            "الاعتماد", "الاعتماد1")
 Set My_sh = Sheets("الاعتماد")
 
 My_sh.Range("J3").CurrentRegion.ClearContents
 For Each Sh In Worksheets
   If IsError(Application.Match(Sh.Name, Ar_sheets, 0)) Then
     ReDim Preserve Ar(x): Ar(x) = Sh.Name: x = x + 1
   End If
 Next
 
 If x > 0 Then
    My_sh.Range("J3").Resize(UBound(Ar) + 1) = _
    Application.Transpose(Ar)
      With My_sh.Range("E3").Resize(49).Validation
      .Delete
      .Add 3, Formula1:=Join(Ar, ",")
      End With
 End If
 Set My_sh = Nothing: Set Sh = Nothing: Erase Ar
 
End Sub

 

[yara ahmed]

معلش فى حاجة تانية لا يستطيع عملها الا حضرتك يا اخى

انا كل مرة باختار من هذه القوائم اسماء الشيتات التى احتاجها من اول e3:e50

فجاتنى فكرة عملت قائمة فى الخلية g 2 تحتوى عى اربع اسماء بيع وشراء واستقطاع واختيار 

وعملت اربع اعمدة n b o q ووضعت تحت كل كلمة فى الاربع اعمدة اسماء الشيتات التى احتاجها 

اريد عندما اختار من القائمةg2 اسم بيع يتم فى العمود e بدأ من الخلية e3 اختيار اسماء الشيتات التى بالعمود n

واذا اختارت من القائمة g2 اسم شراء يتم فى العمود e بدأ من الخلية e3 اختيار اسماء الشيتات التى بالعمود o

وهكذا

والله هدعي لك من كل قلبى

لانى كل مرة اضطر لان اغير ال 50 قائمة حسب اختيار اسم الشيت فجائتنى هذه الفكرة التى ستوفر عليا وقت كبير

مشكور يا باشا ياغالى

yara_data_val.xlsm

تم تعديل سبتمبر 26, 2020 بواسطه yara ahmed

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

الموضوع ممكن حله بواسطة معادلة بسيطة

=CHOOSE(MATCH($G$1,$N$1:$Q$1,0),
                  INDEX($N$2:$N$10,MOD(ROWS($A$1:A1)-1,COUNTA($N$2:$N$10))+1),
                 INDEX($O$2:$O$10,MOD(ROWS($A$1:A1)-1,COUNTA($O$2:$O$10))+1),
                 INDEX($P$2:$P$10,MOD(ROWS($A$1:A1)-1,COUNTA($P$2:$P$10))+1),
                 INDEX($Q$2:$Q$10,MOD(ROWS($A$1:A1)-1,COUNTA($Q$2:$Q$10))+1))

الملف من جديد مغ المعادلة

 

yara_da_val_and formula.xlsm

[yara ahmed]

سليم حاصبيا

انا احبك فى الله اخى اشكرك من قلبى ربنا يفرحك زى ما بتفرحنى

كان نفسى فى طلب 

ينفع المعادلة يكون فيها تعديل بحيث تكتب الى فى العمود بس مش لازم تعيد تانى اسماء الشيتات

ويبقى جميل جميل لو فى العمود d تضع 0 جنب كل خانة مكتوبة فى العمود e وفى العمود b  تكتب سليم جنب

كل اختيار فى العمود e مكتوب فيه

مشكوووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووورر

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

تم التعديل

القوائم المنسدلة يجب ان بكون في هذه الحالة من N2 الى Q50 (لسهولة كتابة اسم الشيت دون احطاء املائية او مسافات زائدة او ناقصة و عدم اضاعة الوفت بكنابتها)

yara_Other_data_val.xlsm

[yara ahmed]

جميل جميل قمر

بحبك يالبنان

سليم حاصبيا

الف مليار شكر اخى حفظك وحماك رب العرش العظيم

 

[yara ahmed]

سليم حاصبيا اخى فى الله معلش انا اسفة والله

عند نقل هذه المعادلة لملفى اعطيتنى خطأ

=@CHOOSE(MATCH($G$1;$N$1:$Q$1;0);
                  INDEX($N$2:$N$10;MOD(ROWS($A$1:A2)-1;COUNTA($N$2:$N$10))+1);
                 INDEX($O$2:$O$10;MOD(ROWS($A$1:A2)-1;COUNTA($O$2:$O$10))+1);
                 INDEX($P$2:$P$10;MOD(ROWS($A$1:A2)-1;COUNTA($P$2:$P$10))+1);
                 INDEX($Q$2:$Q$10;MOD(ROWS($A$1:A2)-1;COUNTA($Q$2:$Q$10))+1))

حيث انى اريدها للعمود R

وعاملة معايا مشاكل وحاولت تسجيل ماكرو وعمل كوبى وبيست لها بس ما نفع من الصبح والله

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

yara_data_val.xlsm

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

ما هذه الاشارة في المعادلة @CHOOSE(MATCH($G$1;$N$1:$Q$1;0);

تأ كدي من الأسماء في النطاق  N1:Q1 ربما تكون هناك مسافات زائدة أو ناقصة  والافضل اخذ هذه الاسماء من نفس النطاق الى data validation في الخلية G1
(انظري الى data validation في الملف الذي رفعته لك)

[yara ahmed]

استاذى الغالى واخى وصديقى سليم حاصبيا

كل مشكلتى اصبحت هذه المعادلة بنسخها نفس الخطأ 

عايزة ازود عمودR وعندما اريد اختيار من القائمة المنسدلة تتمسح

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

لو اردت اختيار من قائمة واتمسحت اضغط الزر ترجع تانى

طبعا طبعا فشلت المحاولة

اضريت اللجوء الى الطبيب 

مع خالص اعتذارى وحبى

 

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

ارى ان الفواصل "," في المغادلة اصبحت فواصل متقوطة ";"

ربما يكون هذا السبب

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

أكيد عندما تغير شيئاً في خلية تحتوي على معادلة فأن المعادلة بتم حذفها واستبدالها بما تم كتابته

لهذا السبب اقترحت في مشاركة سابقة :
 القوائم المنسدلة يجب ان بكون في هذه الحالة من N2 الى Q50 (لسهولة كتابة اسم الشيت دون احطاء املائية او  مسافات زائدة او ناقصة و عدم اضاعة الوفت بكنابتها)

الكود المطلوب لهذه العاية موجود في الملف الذي سبق ورفعته واسمه (yara_Other_data_val)

[yara ahmed]

سأحاول استاذى واخى لان نقل القوائم سبب لى مشكلة

على اتوصل لحل ولو غلبت 

معنديش الا اخى سليم

ربنا يحفظه

ربنا يخليك يارب