عبدالله المجرب

السلام عليكم اليك هذا التعديل للدالة Function Cont_Same(MyRng1 As Range, MyRng2 As Range, MyRng3 As Range, MyRng4 As Range, T As String) Dim cl As Range, cel As Range, R As Integer For Each cl In MyRng1 If Application.CountIf(MyRng2, cl) >= 1 And Sheets(MyRng1.Worksheet.Name).Cells(cl.Row, MyRng3.Column()) = T Then For Each cel In MyRng2 If cel = cl And Sheets(MyRng2.Worksheet.Name).Cells(cel.Row, MyRng4.Column()) = T Then R = R + 1 Next End If Next Cont_Same = R End Function المدى MyRng4 (هو مدى الفئة في الورقة الثانية ) * ملاحظة هامة يجب التأكد من تنسيق ومساواة الارقام في الورقتين

السلام عليكم بالاضافة لحل الاخ هاني هذا الحل باستخدام دالة SUMPRODUCT =SUMPRODUCT(--($B$4:$B$18="central")*($C$4:$C$18)) فقط إستبدل اسم المحافظة في الدالة

سيصبح الكود هكذا Sub ragab() on error resume next Dim sdate As Date, cl As Range sdate = InputBox("أدخل التاريخ الذى تريد تحديد الخلية المقابلة له") For Each cl In [A6:A25] If sdate = cl Then cl.Select: Exit For Else: MsgBox "لاتوجد نتائج لهذا البحث": Exit Sub Next End Sub

السلام عليكم حاولت مع المعادلة السابقة دون نتيجة فقمت بعمل دالة معرفة هي هذه Function Cont_Same(MyRng1 As Range, MyRng2 As Range, MyRng3 As Range, T As String) Dim cl As Range, R As Integer For Each cl In MyRng1 If Application.CountIf(MyRng2, cl) >= 1 And Sheets(MyRng1.Worksheet.Name).Cells(cl.Row, MyRng3.Column()) = T Then R = R + 1 Next Cont_Same = R End Function هذه الدالة بها اربعة متغيرات هي : 1. MyRng1 (هو المدى الذي به الارقام في الورقة الأولى) 2. MyRng2 (هو المدى الذي به الارقام في الورقة الثانية) 3. MyRng3 (هو مدى الفئة في الورقة الأولى) 4. T (هو أسم الفئة) شاهد المرفق 2.rar

تجد طلبك في كود اخونا ابو نصار

أخونا احمد بارك الله لك وبارك عليك وجمع بينكما في خير ميمون مبارك ان شاء الله اللهم اربط بين قلبيهما وارزقهما الذرية الصالحة .

خفض أمان المايكرو

الاستاذ الفاضل بن علية الاخ الكريم الشهابي بارك الله فيكم على الحلول المتميزة

بارك الله فيكم اخواني الكرام على كرم المساعدة ومد يد العون تمت الاجابة

السلام عليكم تفضل المرفق 1.rar

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

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

احسنت استاذ محمود تمت الاجابة

السلام عليكم تم التعديل في الكود ليتحقق من وجود اعمدة مخفيق وحذفها Sub Abu_Ahmed_Trheel_two() Dim cl As Range, Myr As Range Set Myr = Range("A2:E10000") For i = Myr.Column() To Myr.Columns.Count With Columns(i) If .EntireColumn.Hidden = True Then .Delete Shift:=xlToLeft End With Next For Each cl In Range("B2:b" & [B1000].End(xlUp).Row) Sheets("Sheet1").Range("B" & Sheets("Sheet1").[B1000].End(xlUp).Row + 1) = cl Sheets("Sheet1").Range("C" & Sheets("Sheet1").[C1000].End(xlUp).Row + 1) = cl.Offset(0, 1) Sheets("Sheet1").Range("d" & Sheets("Sheet1").[d1000].End(xlUp).Row + 1) = cl.Offset(0, 2) Next MsgBox "تم الترحيل بنجاح ", vbOKOnly, "تنبيه" Set Myr = Nothing End Sub

السلام عليكم اليك هذه الروابط http://www.officena.net/ib/index.php?showtopic=39323&st=40#entry220321 http://www.officena.net/ib/index.php?showtopic=39323&st=60#entry220408

استخدم حماية الورقة شاهد المرفق والفرق بين الخليتين الملونتين فالصفراء تظهر المعادلة ويمكن تعديلها والحمراء مخفية ومحمية حماية الورقة.rar

بارك الله فيك استاذ رجب بارك الله فيك استاذ محمود كل عام وانتم بخير

بارك الله فيك اخي محمود وكل الكر للاخ طاهر لتفهمه والشكر موصول للاستاذ هاني للرد بالمطلوب ابواحمد

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

الاستاذ الفاضل يحيى حسين الاخ الفاضل جروان الاخ الفاضل رجب جاويش الاخ الفاضل طاهر الاخ الفاضل ابو حنيين الاخ الفاضل هاني عدلي الاستاذ الفاضل حاجي بن عليه الاخ الفاضل فؤاد الاستاذ الفاضل ابو خليل الاخ الفاضل عيد مصطفى الاخ الفاضل يوسف كاف الاخ الفاضل ابوردينة الاخ الفاضل محمود لي الاستاذ الفاضل عبدالله باقشير الاخ الفاضل Khhanna الاخ الفاضل يوسف عطا الاخ الفاضل ابن بنها الاخ الفاضل ابو انس حاجب الاخ الفاضل محمد مصطفى الاستاذ الفاضل ابو لميس ( عبدالفتاح كيرة) الاخ الفاضل جمال دغيدي الاخ الفاضل فضل الاخ الفاضل الشهابي =================== شكراً لمشاعركم النبيلة وكل عام وانتم ومن تحبون بألف خير ابواحمد

يقول جل شأنه : "وَبَشِّرِ الصَّابِرِينَ الَّذِينَ إِذَا أَصَابَتْهُمْ مُصِيبَةٌ قَالُوا إِنَّا لِلَّهِ وَإِنَّا إِلَيْهِ رَاجِعُونَ أُولَئِكَ عَلَيْهِمْ صَلَوَاتٌ مِنْ رَبِّهِمْ وَرَحْمَةٌ وَأُولَئِكَ هُمُ الْمُهْتَدُونَ" اللهم اكرم مثواها وأدخلها الجنة .

السلام عليكم اخي ابراهيم خواتيم مباركة لاحظت ان احد المشرفين وضع تعليق بأن هذا العنوان مخالف وقد تم تعديله فالرجاء الالتزام بعناويين تناسب المطلوبوعدم تخصيص أحد بالاعضاء بالطلب =================== لاجابة الاستفسار الخاص بك السبب ان الكود يقوم بعملية تصفية متقدمة ونقل البيانات التي تم تصفيتها (حسب الشروط) الى ورقة العمل (STATMENT) وبذلك تنقل دون تنسيق شرطي

بارك الله فيك اخي بن علية كل التقدير لنشاطك اخي محمود بارك الله فيك اخي ابو حنين ======== الرجاء من الاخ صاحب المشاركة الالتزام بالقواعد الخاصة بالمشاركة (العنوان المناسب) في المرات المقبلة ابو أحمد

السلام عليكم بارك الله فيك اخي جمال الفار وكل عام وانت بخير ====== استخدم تعيين ناحية طباعة لطباعة التحديد الذي تريد

السلام عليكم جرب الاتي غير هذا السطر L = Range(B & 10000).End(xlUp).Row بهذا L = Range(A & 10000).End(xlUp).Row