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

أخي الكريم وائل هذه إضافة لابد وأنك أضفتها أو تم تنصيبها على جهازك ..

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

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

الحمد لله الذي بنعمته تتم الصالحات تقبل وافر تقديري أخي وليد

أخي الغالي ياسر العربي المقصد ليس انتظار رد المساعدة بالمعنى الحرفي هي بس الفكرة زي ما تقول :: يعني أنا أخذتك في الاعتبار واستقطعت من وقتي وجهدي لمساعدتك وفي نهاية المطاف تكسل تنقر بالماوس على كلمة "سجل إعجاب بهذا" الأمر ليس مضني على الإطلاق ، وهو نوع من التقدير ليس إلا أما جزاء المساعدة فلا ننتظره من أحد إنما ننتظره من الله تقبلوا تحياتي

بارك الله فيك أخي الحبيب سليم وإثراءً للموضوع هذا حل آخر باستخدام معادلة صفيف ، توضع في الخلية I5 معادلة صفيف أي بعد الإدخال يتم الضغط على Ctrl + Shift + Enter معاً =IFERROR(INDEX($D$5:$D$40,MATCH(0,IF(ISBLANK($D$5:$D$40),1,COUNTIF($I$4:I4,$D$5:$D$40)),0)),"") Unique List.rar

أخي الكريم سليم الملف المرفق لم يتم تحميله يرجى رفعه مرة أخرى جزاك الله خير الجزاء

أخي الكريم المطلوب غير واضح تماماً يرجى ذكر ورقة العمل المراد العمل عليها وإرفاق شكل النتائج المتوقعة .. وضع نموذج لأمر التعيين (نريد أن نعرف الامتداد المراد التعامل معه .. وكيف سيتم التعامل معه) وكيف يتم إظهار أمر التعيين ؟ هل تقصد بإظهار أمر التعيين فتح الملف المرتبط به وفقط أم تقصد أن يتم إدراجه في ورقة العمل ؟؟؟ مزيد مزيد من التوضيح ليساعدك إخوانك بالمنتدى

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

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

أخي الكريم مازن ممكن مزيد من التفاصيل عن الـ SQL .. حيث أن معظمنا يفتقر للتعامل مع SQL .. بارك الله فيك وجزاك الله كل خير

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

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

أخي الكريم مصطفى في ورقة العمل المسماة "جدول لوحة إعلانات" ضع المعادلة التالية في الخلية E7 ثم قم بسحبها =IFERROR(INDEX(Table1[المكان],MATCH('جدول لوحة اعلانات'!$D7,Table1[المعلم],0)),"") إذا لم تعمل معك المعادلة قم باستبدال الفاصلة العادية في المعادلة بفاصلة منقوطة (ومتنسناش بنص كيلو أوطة .. عشان غالية اليومين دول ) تقبل تحياتي

أخي الحبيب زيزو الملف لا يتم تحميله يرجى إعادة رفعه من جديد تقبل تحياتي

وجزيت خيراً بمثل ما دعوت

فيه حاجة اسمها ثابت أو مطلق زي كدا $A$1 كدا العمود ثابت والصف ثابت يعني لما أضيف علامة الدولار قبل اسم العمود أو رقم الصف دا بيخلي المرجع ثابت فهنا العمود ثابت ورقم الصف ثابت $A1 هنا العمود ثابت والصف متغير ..يبقا لما أسحب المعادلة اللي هيتغير هنا هو رقم الصف فقط أما العمود فمطلق أو ثابت A$1 هنا العمود متغير ورقم الصف ثابت يعني الصف مطلق ..يبقا لما اسحب المعادلة الصف لن يتغير (والسحب لو كان في نفس العمود يبقا العمود مش هيتغير لكن لو سحب المعادلة عبر صف محدد فاسم العمود هيتغير) A1 الحالة الرابعة والأخيرة كلاهما العمود والصف متغير ..وليس ثابت أرجو أن تفيدك هذه المعلومات ..

تمت الإجابة في الموضوع الخاص بهذه النقطة تقبل تحياتي

أخي وائل الأسيوطي يمكن عمل ذلك بالسحب أي سحب المعادلة ..قف في الخلية F42 ستجد مربع أسود صغير أسفل يمين الخلية (ركز بقولك مربع صغير أسود) دا اسمه مقبض السحب تعال امشي بالماوس من غير ما تضغط وقف على مقبض السحب هتلاقي شكل المؤشر بقا مختلف بقا لونه إسود بردو .. امسك المقبض بالماوس من النقطة دي (مقبض السحب) مع الاستمرار واسحب لحد آخر النطاق المطلوب ..بس خلاص طريقة تانية انسخ المعادلة في الخلية وحدد الخلايا المراد نسخ المعادلة إليها ثم كليك يمين على الخلايا واختر لصق خاص ومن النافذة اختر "معادلات" Formulas عشان ينسخ المعادلات فقط .. طريقة ثالثة باستخدام الكود يمكن استخدام السطر التالي لتنفيذ المطلوب Sub FillFormulas() Range("F41").AutoFill Destination:=Range("F41:F70") End Sub أرجو أن يكون المطلوب

جرب تعدل المعادلة بهذا الشكل =IF(E42="",0,COUNTIF(Coverag!U5:U562,E42))

الحمد لله أخي الحبيب جعفر على عودتك إن شاء الله حاول تعمل حسابك عند كتابة الأكواد النظامين معاً 32 بت و 64 بت حتى يكون الكود متكامل وفقك الله لما يحب ويرضى

أخي وحبيبي في الله سعيد بيرم أسأل الله العظيم رب العرش العظيم أن يشفيك لا بأس طهور إن شاء الله

أخي ياسر أضف جزء للكود في حدث الفورم بحيث يظهر النص "لا توجد صورة" في حالة عدم التطابق للرقم مع الصورة ...

أخي الكريم مصفطى ضع الكود التالي في موديول Public Coll As New Collection Public Function RefreshCollection() As Collection Dim collDummy As New Collection, ArrIn, ArrHead, I As Long, J As Long, Str1 As String, V Set Coll = Nothing With Sheet1.Range("C46").CurrentRegion ArrIn = .Value ArrHead = .Resize(1).Offset(-44).Value For J = 3 To UBound(ArrIn, 2) Step 2 For I = 2 To UBound(ArrIn, 1) If Len(ArrIn(I, J)) Then On Error Resume Next Str1 = CStr(ArrIn(I, J)) V = Coll(Str1) If Err.Number <> 0 Then Set collDummy = Nothing Coll.Add Key:=Str1, Item:=collDummy End If On Error GoTo 0 Coll(Str1).Add Array(ArrIn(I, J), ArrIn(I, J - 1), ArrHead(1, J - 1)) End If Next I Next J End With Set RefreshCollection = Coll End Function Public Function GetData(Param As String) Dim ArrOut, I As Long, V1, V2 If Coll.Count = 0 Then Set Coll = RefreshCollection() On Error Resume Next Set V1 = Coll(Param) If Err.Number = 0 Then ReDim ArrOut(1 To V1.Count, 1 To 2) For Each V2 In V1 I = I + 1 ArrOut(I, 1) = V2(1) ArrOut(I, 2) = V2(2) Next V2 GetData = ArrOut End If On Error GoTo 0 End Function ثم أدرج موديول جديد وضع فيه الكود التالي Sub UpdateAll() Dim I As Long, J As Long Application.ScreenUpdating = False For I = 8 To 80 Step 3 Sheet2.Cells(4, I).Value = J + 1 J = J + 1 Next I Application.ScreenUpdating = True End Sub قم بإنشاء زر أو أي شكل في ورقة العمل "حصص المعلمين" ثم كليك يمين على الزر واختر Assign Macro ثم اختر الماكرو المسمى UpdateAll لربط الزر بهذا الإجراء الفرعي وأخيراً ضع الكود التالي في حدث ورقة العمل المسماة "حصص المعلمين" ..من خلال كليك يمين على اسم ورقة العمل ثم اختر View Code والصق الكود التالي Private Sub Worksheet_Activate() Set Coll = RefreshCollection() End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim Arr, strAddress As String, lCol As Long If Not Intersect(Target, Union(Range("H4"), Range("K4"), Range("N4"), Range("Q4"), Range("T4"), Range("W4"), Range("Z4"), Range("AC4"), Range("AF4"), Range("AI4"), Range("AL4"), Range("AO4"), Range("AR4"), Range("AU4"), Range("AX4"), Range("BA4"), Range("BD4"), Range("BG4"), Range("BJ4"), Range("BM4"), Range("BP4"), Range("BS4"), Range("BV4"), Range("BY4"), Range("CB4"))) Is Nothing Then Application.EnableEvents = False strAddress = Target.Address(0, 0) lCol = Range(strAddress).Column Range(Cells(6, lCol), Cells(1000, lCol - 1)).ClearContents Arr = GetData(Target.Value) If IsArray(Arr) Then Cells(6, lCol - 1).Resize(UBound(Arr, 1), UBound(Arr, 2)).Value = Arr Application.EnableEvents = True End If End Sub أرجو أن تكون الخطوات واضحة إذا تعذر عليك الأمر سأقوم بإرفاق ملف

خسارة ..جيت متأخر يا عربي خدها الصقر وطار