رجب جاويش

هل تقصد هكذا بحث1.rar

أخى الفاضل جرب هذا الكود Sub ragab() LR = Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To LR Range("D" & i).FormulaArray = _ "=INDEX(R2C12:R82C16,MATCH(R[0]C[-3]&""-""&R2C2,R2C16:R82C16&""-""&R2C15:R82C15,0),2)" Next End Sub sample.rar

الأخ الفاضل / kmaal شكرا جزيلا أخى الفاضل وكل عام وأنتم بخير

جرب هذا التعديل Private Sub Worksheet_Selectionchange(ByVal Target As Range) For i = 9 To [A10000].End(xlUp).Row If Cells(i, 1) <> "" Then y = Mid(Cells(i, 1), InStr(Cells(i, 1), "/") + 1) & "/" & _ Mid(Cells(i, 1), InStr(Cells(i, 1), "/") - 2, 2) Cells(i, 2) = y Cells(i, 3) = Mid(Cells(i, 1), InStr(Cells(i, 1), "/") + 1) End If Next End Sub

الأستاذ الفاضل / عبد الله المجرب شكرا جزيلا لك على هذا التشجيع والكلمات الطيبة وجزاك الله كل خير وشكرا جزيلا على هذه المعلومات القيمة

تفضل أخى تم اختصار الكودين فى كود واحد لتنفيذ المهمتين Private Sub Worksheet_Selectionchange(ByVal Target As Range) For i = 11 To [A10000].End(xlUp).Row y = Mid(Cells(i, 1), InStr(Cells(i, 1), "/") + 1) & "/" & _ Mid(Cells(i, 1), InStr(Cells(i, 1), "/") - 2, 2) Cells(i, 2) = y Cells(i, 3) = Mid(Cells(i, 1), InStr(Cells(i, 1), "/") + 1) Next End Sub 3.rar

هل تظهر معك رسالة خطأ معينة

السلام عليكم أهلا بك أخى الفاضل بين إخوانك رجاء بسيط فى المرات القادمة : مراعاة أن يكون العنوان مناسب لموضوع الطلب تفضل ما تريد Book1.rar

أرجو التوضيح أكثر وما الغرض من دمج الكودين معا

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

تفضل أخى تعديل كود.rar

وهذا حل آخر عن طريق الكود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = [B2].Address Or Target.Address = [C2].Address Then For Each cl In [A6:A25]: For Each cll In [B6:F4] If cl = [B2] And cll = [C2] Then [D2] = Cells(cl.Row, cll.Column).Value Next: Next End If End Sub حيث يتم تنفيذ الكود بمجرد الإختيار من الخلية B2 أو الخلية C2 الرتب والدرجات.rar

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

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

أخى الفاضل شكرا جزيلا أخى الفاضل على هذه الكلمات الطيبة وجزاك الله كل خير

أخى الفاضل / tahar1983 شكرا جزيلا على هذا الدعاء الطيب وجزاك الله كل خير

السلام عليكم تفضل أخى الرتب والدرجات.rar

هل تقصد هكذا 3.rar

أخى الفاضل / محمود على محمود شكرا جزيلا اخى الفاضل على هذا المرور العطر

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

تفضل أخى تعديل كود.rar

فكرة حذف الصف كله تعتمد على الجزء الأخير من هذا السطر Sheets(i).Range(Cells(A, 1), Cells(Rows.Count, 5)).EntireRow.Delete وهو الجزء EntireRow.Delete وهو يعنى حذف كامل الصف الذى يوجد به المدى المحدد فى الجزء الأول من السطر

وجزاك الله بمثله وأكثر أخى الفاضل وتقبل الله منا ومنكم صالح الأعمال

بعد اذن أخى الحبيب / أبو حنين هذه محاولة وفكرة أخرى الجهة.rar

السلام عليكم جرب المرفق barem1.rar