طالب مدرسة أوفيسنا

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

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

المطلوب بالمرفقات22.rar

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

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

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

تعم تعديل الكود بحيث يظهر عام 2015 على حده بشكل بطريقة بدائية امل ان يكون واضح بالمرفقات مثال.rar

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

استاذ ياسر هل ممكن شرح لهذا الكود حاولت ولم افهم طريقة التصفية ولا عكس استعمالك للداله Min الكود محترف واريد فهم طريقته

ماشاء الله كود جميل تم به المطلوب اكرر شكري لك استاذ ياسر

الأقدم في التاريخ

الف شكر استاذنا الغالي ياسر لامشكله الاكتفاء بالاول منها

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

نسأله تعالى أن يغفر له ويرحمه ويدخله الجنة

الف شكر لكل من حاول المساعده مشرفنا الغالي ياسر كود رائع ومحترف تم به المطلوب

السلام عليكم كما في العنوان مطلوب كود اصغر قيمة لنطاق متغير مرفق الملف اصغر قيمة.rar

مشكور مشرفنا الغالي على التنبيه تم التعديل ولكم جزيل الشكر

مشكور استاذي العزيز نعم هذا هو المطلوب

السلام عليكم المعادلة مقارنة بين تاريخين ويقوم بستخراج اقل قيمه في الفتره المعادلة لاتعطي الحل الصحيح INDEX($A$21:$E$600;SMALL(IF((C21:C600>O5)*(O6>C21:C600);ROW(E21:E600));1);COLUMN(E1) تم تغيير SMALL ب MIN ولازالة نفس المشكله نموذج للمطلوب بالمرفقات مع الشكر نموذج.rar

تسلم اخوي الصقر يبدو اني لم اوصل الفكره بالشكل الصحيح المطلوب ليس اختصار للكود فقط ايضا للعمليات مثل العمود G و H اريد الاستغناء عنها هي تقوم بالفرز في حال تطابق مع الشرط يكتب "تنفيذ" وفي حال عدم التطابق يعوض بصفر مااريد اختصار لست في حاجه للعمود غير المطابق للشروط ، وارد الاختصار بحيث يبحث في حال كان مطابق يتم ترحيله وذا لم تنطابق يتجاهله وينتقل للتالي دون التعويض بصفر بحيث يكون الترحيل متتالي بدون اصفار او فراغات مع الشكر

لرفع

السلام عليكم ،،، وجمعة مباركه على الجميع بختصار // هذا الكود يقوم بالفلتره بواسطة عملية حسابيه Sub Macro1() Dim lr As Long Application.ScreenUpdating = False lr = Range("b" & Rows.Count).End(xlUp).Row Range("G18").FormulaR1C1 = "=MAX(R[1]C[-4]:R65536C3)" Range("H18").FormulaR1C1 = "=IF(RC[-4]>RC[-1],""تنفيذ"",)" Range("G18:H18").AutoFill Destination:=Range("G18:H" & lr), Type:=xlFillDefault Range("G18:H" & lr) = Range("G18:H" & lr).Value Application.ScreenUpdating = True End Sub وهذا الكود يقوم بترحيل ناتج العملية الحسابيه في حال توفر الشرط Private Sub CommandButton1_Click() Dim Cl As Range If [H17] = "" Then Exit Sub For Each Cl In Range("H18:H" & [H5000].End(xlUp).Row) If Cl.Value = [H17] Then Cl.Offset(0, -6).Resize(1, 3).Copy Range("N" & [N5000].End(xlUp).Row + 1).PasteSpecial xlPasteValues End If Next MsgBox "تم الترحيل بنجاح ", vbOKOnly, "تنبيه" End Sub المطلوب اختصار العملية والاستغناء عن الفلتره ونقل العملية الحسابية لزر الترحيل بحيث يقوم بالحساب وترحيل مايوافق الشروط والاستغناء عن مالاتنطبق عليه الشروط مع الشكر مرفق للتوضيح نموذج1.rar

مشكور استاذ سليم نعم هذا المطلوب اكرر شكري لك وللقائمي على هذا المنتدى

مرفق المطلوب بشكل واضح مع الشكرنموذج2.rar

المطلوب تعديل بستبدال خلية الشرط G1 بكلمة "تنفيذ" بمعنى يبحث داخل العمود اذا وجد كلمة "تنفيذ" يرحل الكود يعمل بشكل جيد مع البيانات القليله ولما اضع تقريبا 3000 صف الكود لاينفذ ويعطي مسج تم الترحيل وهو غير صحيح اعتقد بناء الكود بشكل مختلف يحل المشكله مع الشكر Dim Cl As Range If [G1] = "" Then Exit Sub For Each Cl In Range("O21:O" & [O6000].End(xlUp).Row) If Cl.Value = [G1] Then Cl.Offset(0, -14).Resize(1, 7).Copy Range("R" & [R6000].End(xlUp).Row + 1).PasteSpecial xlPasteValues End If Next MsgBox "تم الترحيل بنجاح ", vbOKOnly, "تنبيه" End Sub