hegazee

الملف يعمل و الكود شغال و دي النتيجة النتيجة

أخي العزيز أين الملف؟

و عليكم السلام ورحمة الله و بركاته استخدم الكود التالي Sub CreateSheetsFromList() Dim ws As Worksheet Dim cell As Range Dim newSheet As Worksheet Dim shName As String ' الورقة اللي فيها الأسماء Set ws = ThisWorkbook.Sheets("Sheet3") ' غير اسم الورقة حسب ملفك ' المرور على العمود A For Each cell In ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row) If Trim(cell.Value) <> "" Then shName = Trim(cell.Value) On Error Resume Next ' التأكد إنه مفيش ورقة بنفس الاسم Set newSheet = ThisWorkbook.Sheets(shName) On Error GoTo 0 If newSheet Is Nothing Then ' إنشاء ورقة جديدة بالاسم ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = shName End If Set newSheet = Nothing End If Next cell MsgBox "تم إنشاء الأوراق بنجاح", vbInformation End Sub New.xlsm

و عليكم السلام ورحمة الله و بركاته تفضل =INT((DATEDIF(D13;E13;"y")+DATEDIF(D14;E14;"y")+(DATEDIF(D13;E13;"ym")+DATEDIF(D14;E14;"ym")+(DATEDIF(D13;E13;"md")+DATEDIF(D14;E14;"md"))/30)/12)) & " years; " & MOD(DATEDIF(D13;E13;"ym")+DATEDIF(D14;E14;"ym")+INT((DATEDIF(D13;E13;"md")+DATEDIF(D14;E14;"md"))/30);12) & " months; " & MOD(DATEDIF(D13;E13;"md")+DATEDIF(D14;E14;"md");30) & " days" معادلة طرح وجمع تاريخين 2.xlsx

مرفق شيت به 1000 اختصار لبرنامج الاكسيل لتسهيل العمل منظم حسب الاصدارات للاستاذ/ محمود سيد جزاه الله خيرا 1000 اختصار للاكسيل محمود سيد.xlsx

بارك الله فيك أستاذ أحمد . كما تفضلت حضرتك بالملف فإن معادلة العلامة خبور رائعة و تصلح لهذا الملف تماما فقط قم بنسخ الكود التالي في موديل جديد في في محرر الأكواد Function kh_Names(FullName As String, ParamArray iNdex1()) As String Dim i As Integer Dim kh_Split, MyArray, Ar Dim Kh_String As String, Sn As String, Re As String On Error GoTo Err_Kh_Names '====================================== MyArray = Array("عبد ", "أبو ", "ابو ", "آل " _ , " الله", " الدين", " الإسلام", " الاسلام", " الحق") '====================================== Sn = Application.WorksheetFunction.Trim(FullName) For Each Ar In MyArray Re = Replace(Ar, " ", "^") Sn = Replace(Sn, Ar, Re) Next '====================================== kh_Split = Split(Sn, " ", , vbTextCompare) On Error Resume Next For i = 0 To UBound(iNdex1) Kh_String = Kh_String & " " & kh_Split(iNdex1(i) - 1) Next On Error GoTo 0 Kh_String = Replace(Trim(Kh_String), "^", " ") kh_Names = Kh_String Exit Function Err_Kh_Names: kh_Names = "" End Function ثم ضع المعادلة التالية في خانة اسم الأب مثلا: =kh_Names(H9;2;3;4;5) مع مراعاة الفاصلة عادية أو منقوطة حسب اصدار الاوفيس مجمع 2026بعد نتيجة ثالثة.xlsm

السلام عليكم بعد إذنكم جميعا تم حل الموضوع في آخر مشاركة لي في هذا البوست يوم 17 أغسطس و النتائج كما طلب الاستاذ عادل. الآن أين المشكلة؟

تمام كان الخطأ في كود اسم الورقة المفروض يكون www

و عليكم السلام جرب الملف الرقم السري 1234 كود إخفاء واظهار شيتات محددة برقم سري والباقي ظهار 2.xlsm

جرب الملف التالي مع أن حجم البيانات هائل و يستغرق وقت طويل و يستهلك رامات الكمبيوتر 512 صفحة و كل صفحة بها 3 كشوف. الكود يقوم بتصدير الكشوف إلى مجلد على شكل ملفات بي دي اف كل ملف به 3 كشوف و كذلك إنشاء ورقة عمل بالتقسيمات Book2.xlsm

تفضل الملف و جرب كتابة اسماء بها عبد في العمود الثالث و طبق عليها ما تريد حذف المسافات(1).xlsm

وعليكم السلام ورحمة الله و بركاته بعد إذن أستاذنا / حسونه الكود التالي يقوم بعمل اللازم و ضع مسافة بين عبد و أسماء الله الحسنى مثل عبد الله كلمتان و سيكون بعده كود آخر بدون مسافة أي عبدالله مثلا ستكون كلمة واحدة الكود الأول ( عبد الله) Sub CleanSpaces() Dim ws As Worksheet Dim lastRow As Long Dim cell As Range Dim t As String Dim reAbd As Object Dim scr As Boolean, calc As Long Set ws = ActiveSheet lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row scr = Application.ScreenUpdating calc = Application.Calculation Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set reAbd = CreateObject("VBScript.RegExp") With reAbd .Global = True .IgnoreCase = False .Pattern = "عبد(?=[اأإآء-يؤئبةتى])" End With For Each cell In ws.Range("C1:C" & lastRow) If Not cell.HasFormula Then If VarType(cell.Value) = vbString Then t = CStr(cell.Value) t = Replace(t, Chr(160), " ") t = Replace(t, vbTab, " ") t = Replace(t, ChrW(8206), "") t = Replace(t, ChrW(8207), "") t = Application.WorksheetFunction.Trim(t) t = reAbd.Replace(t, "عبد ") t = Application.WorksheetFunction.Trim(t) If cell.Value <> t Then cell.Value = t End If End If Next cell Application.ScreenUpdating = scr Application.Calculation = calc MsgBox "تم تنظيف العمود C ومعالجة 'عبد' .", vbInformation End Sub الود الثاني بدون مسافة: عبدالله Sub CleanSpaces() Dim ws As Worksheet Dim lastRow As Long Dim cell As Range Dim t As String Dim reAbd As Object Dim scr As Boolean, calc As Long Set ws = ActiveSheet lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row scr = Application.ScreenUpdating calc = Application.Calculation Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set reAbd = CreateObject("VBScript.RegExp") With reAbd .Global = True .IgnoreCase = False .Pattern = "عبد\s+(?=[اأإآء-يؤئبةتى])" End With For Each cell In ws.Range("C1:C" & lastRow) If Not cell.HasFormula Then If VarType(cell.Value) = vbString Then t = CStr(cell.Value) t = Replace(t, Chr(160), " ") t = Replace(t, vbTab, " ") t = Replace(t, ChrW(8206), "") t = Replace(t, ChrW(8207), "") t = Trim(t) Do While InStr(t, " ") > 0 t = Replace(t, " ", " ") Loop t = reAbd.Replace(t, "عبد") t = Trim(t) If cell.Value <> t Then cell.Value = t End If End If Next cell ' استرجاع الإعدادات Application.ScreenUpdating = scr Application.Calculation = calc MsgBox "تم تنظيف العمود C بالكامل وإزالة المسافات المكررة والمسافة بعد 'عبد'.", vbInformation End Sub

و عليكم السلام ورحمة الله وبركاته الملف المرفق لا توجد به اي أكواد لتعديلها فما المطلوب ؟ هل إنشاء كود لأن الكود الذي كتبته غير مكتمل فهو جزء من كود

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

تفضل الملف كامل . ما عليك إلا أن تكتب البيانات في صفحات الشهور و سيظهر الفرز تلقائيا في صفحة تم أو غير مسدد 4الحساب.xlsx

و إياكم أخي الكريم

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

الله ينور عليك. جزاكم الله خيرا

أولا تم تعديل المعادلة لتكون: =IF(G2="";"";IF(G2<1;"أقل من فدان";IF(AND(G2>=1; G2<3);"من 1 إلى أقل من 3 فدان";IF(AND(G2>=3; G2<5);"من 3 إلى أقل من 5 فدان";IF(AND(G2>=5; G2<10);"من 5 إلى أقل من 10 فدان";IF(AND(G2>=10; G2<20);"من 10 إلى أقل من 20 فدان";IF(AND(G2>=20; G2<=25);"من 20 إلى 25 فدان";"أكثر من 25 فدان"))))))) شرح المعادلة: تستخدم الدالة IF بشكل متداخل لتصنيف قيمة موجودة في الخلية G إلى فئات مختلفة بناء على مدى هذه القيمة مع افتراض أن القيمة تمثل مساحة بالأفدنة تماما مثل إظهار نتيجة الطلاب بالتقديرات IF(G2="";"") إذا كانت الخلية G2 فارغة، فإن الناتج يكون فارغًا أيضا لا يعرض شيء. هذا يجنب ظهور نتائج غير مرغوبة عند عدم وجود بيانات. IF(G2<1;"أقل من فدان") إذا كانت القيمة في G2 أقل من 1 لكن ليست فارغة يعرض: "أقل من فدان". IF(AND(G2>=1; G2<3) إذا كانت القيمة أكبر من أو تساوي 1 ولكن أقل من 3 يعرض: "من 1 إلى أقل من 3 فدان". وهكذا باقي المساحات أما المعادلة =IF(AND(ISNUMBER(D2); ISNUMBER(E2); ISNUMBER(F2)); F2 + E2/24 + D2/576; "") تستخدم لتحويل وحدات الأراضي (الفدان، القيراط، السهم) إلى قيمة عشرية واحدة تعبر عن المساحة الكلية بالفدان. الوحدات المستخدمة في مصر: الفدان (F2) ← الوحدة الأساسية. القيراط (E2) ← 1 فدان = 24 قيراط. السهم (D2) ← 1 قيراط = 24 سهم → إذن 1 فدان = 576 سهم (24 × 24) ثانيا: ملفك الأصلي فيه بعض الملاحظات فهناك صفوف فارغة تماما و أيضا الخلايا فارغة ليس بها أي رقم المفروض نضع صفر في الخلايا الفارغة لتدخل ضمن حساب المعادلة أيضا هناك أسماء لا تملك حتى سهم و بالتالي لا تدخل ضمن الأفراد ذوي الملكية بعد التعديلات ستلاحظ أن العدد مضبوط فئات الانتفاع2.xlsx

و عليكم السلام ورحمة الله وبركاته إليك المطلوب فئات الانتفاع.xlsx

تقضلوم الملف بالمعادلات المتوافقة مع الاصدارات القديمة لأكسيل و ابت الملف بدون أكواد مع أن الأكواد افضل لأنها تى و إن اضفت صفحات لأشهر جديدة فان الكود سيرحل البيانات تلقائيا . على العموم ابتعدت عن دالة فلتر التي تستخدم في اكسيل 2019 فما فوق 3الحساب.xlsx

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

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

تفضل هذا الملف باجتهاد شخصي مني أملا في أن تكون هناك اضافات و تحسينات من الأساتذة في المنتدى مبيعات ومخازن.xlsx