سليم حاصبيا

جرب هذا الملف ABd_sabah.xlsx

اختيار القرعة مثلا فريق 15 Choose _rand_name.xlsm

أجب أن الفت نظرك ان هذا الماكرو يجب ان يوصع في Module الصفحة و ليس قي Module مستقل

في سطر الــ Address يجب كتابة "F2" و ليس "f2" لأن لهذا الأمر أهمية

المعادلة من نوع Array_Formula لذلك يجب الضغط على Ctrl+Shift +Enter وليس Enter وحدها

يمكن ان بكون المطلوب Wael H.xlsx

تم معالجة الأمر مجرد ما تختارين القيمة المناسبة من الحلية G1 ينفذ الماكرو فوراً الخلية G1 تحتوي غلى فائمة متسدلة (رؤوس الأعمدة) من N الى R Yara_Formula_to_Vba.xlsm

الحل =CHOOSE(MATCH($G$1,$N$1:$R$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), INDEX($R$2:$R$10,MOD(ROWS($A$1:A1)-1,COUNTA($R$2:$R$10))+1)) لاحظي الصورو

جرب هذا الشيء Ahmedabutaleb.xlsx

هل الأعمدة تبدأ من N أو من O ????

الكود المناسب Option Explicit Sub My_formula() With Range("H4:H48") .Formula = "=IF(E3="""","""",$B$2)" .Value = .Value End With End Sub

ربما يكون المطلوب Hasan_3.xlsb

الان فهمت ماذا تريد =IF(NOT(ISNUMBER(A2)),"",DATE(YEAR(A2)+B2,MONTH(A2),DAY(A2)-1)) أو =IF(NOT(ISNUMBER(A2));"";DATE(YEAR(TODAY())+B2;MONTH(A2);DAY(A2)-1)) الملف من جديد Hasan_1.xlsb

هذه معادلة توضغ في الحلايا ويتم تنفيذها قور كتابتها والضغط غلى Enter الملف مرفق Hasan.xlsb

هذه المعادلة في C2 واسحب نزولاً =IF(NOT(ISNUMBER(A2)),"",DATE(YEAR(A2)+B2,MONTH(A2),DAY(A2)-1)) واذا لم تعمل معك استبدل الفاصلة بقاصلة منقوطة (هذا يتعلق باعدادات الحهاز غتدك) لتصبح هكذا =IF(NOT(ISNUMBER(A2));"";DATE(YEAR(A2)+B2;MONTH(A2);DAY(A2)-1))

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

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

ما هذه الاشارة في المعادلة @CHOOSE(MATCH($G$1;$N$1:$Q$1;0); تأ كدي من الأسماء في النطاق N1:Q1 ربما تكون هناك مسافات زائدة أو ناقصة والافضل اخذ هذه الاسماء من نفس النطاق الى data validation في الخلية G1 (انظري الى data validation في الملف الذي رفعته لك)

1-استطعت بالرغم من ضيق الوقت الى هذا الملف (يمكن المتابعة فبما بعد) 2- اتبع هذه الصورة لمعرفة كيفية التعامل مع اليوزر الملف مرفق MHmd188.xlsm

أوّلاً lاذا تريد ان تفعل باليوزر؟؟؟؟ ثانياً الكود الصحيح لليوزر Initialize Private Sub UserForm_Initialize() Dim i Me.TABELDATA.RowSource = _ Sheets("DATA").Range("A2:H" & _ Cells(Rows.Count, "H").End(3).Row).Address For i = 1 To 8 Me.KOLOM.AddItem Sheets("DATA").Cells(1, i) Next End Sub

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

الموضوع ممكن حله بواسطة معادلة بسيطة =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

ممكن هذا الشيء لكن اذا كانت الشبتات كثيرة الأفضل استعمال 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

في اي شبت تريدين هذه القائمة اذا كان في شيت الاعتماد هذا الكود او اختاري اي شيت اخر من خلال الكود 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

في الملف الذي رفعته لك 1-جرب اضافة بعض السجلات (عامود الترقيم " A " لا تمسه لانه يرفم تلقائيا بمجرد ان يكتمل الصف 5 عناصر) 2- احقظ الملف 3-اغلق الملف 4- قم باعادة فتحه 5- لاحظ ان كل شيء في موقعه الصحيح