عبدالله بشير عبدالله

السلام عليكم اخى الفاضل الاسباب كثيرة منها ربما الإصدارين مثبتان بشكل صحيح وتوجد تعارضات بينهما ربما عدم وجود Microsoft Forms 2.0 Object Library ربما التحديثات التلقائية لأحد الإصدارين إلى تعطيل أو إفساد إعدادات الإصدار الآخر على كل حال ارفاق ملف يقفل باب ربما في انتظار ارفاق ملفك لاصدار 2016 وهو الموجود حاليا على جهازي لك كل الود والاحنرام

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

وعليكم السلام ورحمة الله وبركانه الكود Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Not Intersect(Target, Me.Range("B:B")) Is Nothing Then Dim c As Range For Each c In Target If c.Value <> "" And IsEmpty(c.Offset(0, 1).Value) Then c.Offset(0, 1).Value = Date End If Next c End If If Not Intersect(Target, Me.Range("D:D")) Is Nothing Then Dim dCell As Range For Each dCell In Target If dCell.Offset(0, 2).Value = "إجازة" Then If Application.WorksheetFunction.CountIfs(Me.Range("D:D"), dCell.Value, Me.Range("F:F"), "إجازة", _ Me.Range("E:E"), ">=" & DateSerial(Year(dCell.Offset(0, -1).Value), Month(dCell.Offset(0, -1).Value), 1), _ Me.Range("E:E"), "<=" & WorksheetFunction.EoMonth(dCell.Offset(0, -1).Value, 0)) > 5 Then dCell.Interior.Color = RGB(255, 0, 0) Else dCell.Interior.ColorIndex = -4142 End If Else dCell.Interior.ColorIndex = -4142 End If Next dCell End If Application.EnableEvents = True End Sub الملف اجاز.xlsb

وعليكم السلام ورحمة الله وبركانه العمود c كود Sub CalculateValues() Dim ws As Worksheet Dim lastRow As Long Dim i As Long Dim colA As Double Dim colB As Double Set ws = ThisWorkbook.Sheets("Sheet1") lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row For i = 1 To lastRow colA = ws.Cells(i, "A").Value colB = ws.Cells(i, "B").Value If colB <= 500 And colA > 3000 Then ws.Cells(i, "C").Value = colA * 1.5 ElseIf colB > 500 And colA > 3000 Then ws.Cells(i, "C").Value = colA * 2.5 ElseIf colB < 500 And colA < 3000 Then ws.Cells(i, "C").Value = 6000 Else ws.Cells(i, "C").Value = "" End If Next i End Sub العمود d معادلة =IF(B1<500; IF(A1>3000; A1*1.5; 6000); IF(A1>3000; A1*2.5; "")) test2025.xlsb

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

وعليكم السلام ورحمة الله وبركاته Private Sub Workbook_Open() On Error Resume Next ThisWorkbook.Sheets("الــــــــــــــــوارد ").ScrollArea = "A1:I753" End Sub "A1:I753" هذا النطاق يمكن تعديله وهو المسموح الكتابه به اذا اردت النطبيق على جداول اخرى انسخ ThisWorkbook.Sheets("الــــــــــــــــوارد ").ScrollArea = "A1:I753" والصقه بالكود وغير اسم الصفحة والنطاق سجل.xlsb

السلام عليكم بعد اذن الاساتذة الاكارم معادلة =IF(L10>0;L10&" فدان";"") & IF(AND(L10>0;K10>0);" و ";"") & IF(K10>0;K10&" قيراط";"") & IF(AND(OR(L10>0;K10>0);J10>0);" و ";"") & IF(J10>0;J10&" سهم";"") & IF(AND(OR(L10>0;K10>0;J10>0);I10>0);" و ";"") & IF(I10>0;I10&" م²";"") الملف مساحة.xlsx

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

وعليكم السلام ورحمة الله وبركاته ملف بحنوى على كود و7 طرق عد بالمعادلات اختر ما يناسبك عد الخلايا الرقمية.xlsb

السلام عليكم ورحمة الله وبركاته اكثر من مرة ادخل الى موضوعك عسى ان اقدم شيئا لحل مشكلة الملف ولكن اتركة للاسباب التالية :- زر ترحيل البيانات يعطى خطأ والسبب ارتباطه بملف اخر لا نعلم ما به واسم الملف ("نموذج فلترة ايام الغياب.xlsm") ربما على جهازك لا يظهر الخطأ لان الملف موجود به ولكن لدينا نظهر رسالة الخطأ Set sourceWorkbook = Workbooks.Open(sourcePath) Set destinationWorkbook = Workbooks("نموذج فلترة ايام الغياب.xlsm") الصفحات التي ليس لها علاقة بالطلب كان يجب حذفها والاكواد التي ليس لها علاق كذلك والبيانات بالملف كان ادراج 15 او 20 اسما يكفى بدل من اكثر من 1000 كان الاجدر ان حددت الاسم او رقم الصف لهذه الحالة او ميزنها بلون فمن لديه الوقت للبحث في 1000 اسم وهل هذا الخطأ للكل ام لبعض الحالات راجعت اول اسم والثاني والثالت وجدت الامور منطابقة واذا كانت هناك حالات كان تحديدها او تميزها بلون اخنصارا للوقت في انتظار توضيح طلبك اكثر وسيكون اعضاء المنتدى مستعدين لتقديم المساعدة لك ولغيرك ان شاء الله عذرا ولك كل الاحترام والتقدير

وعليكم السلام ورحمة الله وبركاته ضف هذا السطر للكود wsSource.Cells(i, 1).Resize(1, 14).ClearContents الكود كاملا Sub test() Dim wsSource As Worksheet Dim wsPass As Worksheet Dim lastRow As Long Dim i As Long Dim passRow As Long Dim passCount As Long Dim failRow As Long Dim wsFail As Worksheet Set wsSource = ThisWorkbook.Sheets("Sheet1") Set wsPass = ThisWorkbook.Sheets("Sheet2") lastRow = wsSource.Cells(wsSource.Rows.Count, "a").End(xlUp).Row passRow = 4 For i = 3 To lastRow If InStr(1, LCase(wsSource.Cells(i, "g").Value), "1/6") > 0 Then wsPass.Cells(passRow, 1).Resize(1, 14).Value = wsSource.Cells(i, 1).Resize(1, 14).Value wsPass.Cells(passRow, 1).Value = passRow - 3 wsPass.Cells(passRow, 1).NumberFormat = wsSource.Cells(i, 1).NumberFormat ' نسخ التنسيق wsSource.Cells(i, 1).Resize(1, 14).ClearContents passRow = passRow + 2 End If Next i End Sub

السلام عليكم حفظ الصورة + غرض البيانات الخطوات زر تفريغ البيانات تعبئة البيانات ورقم القيد اجباري زر اظافة ومدمج معه تحميل الصورة ويمكن تحميل الصورة من اي ملف على جهاز الكمبيوتر عرض البيانات - البحث بالقيد او بالاسم مع استدعاء الصورة انتهي الملف المنظومة11.xlsm

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

السلام عليكم ورحمة الله وبركاته قولى متوسطة لاننى جربت ملفك على جهازي وموارد جهازي جيدة وليست جيدة جدا وملفك يعمل بكفاءة على جهازي حيث قمت بملء الاعمدة التي ذكرنها الى الصف 1006 ولم يتجمد وامور الملف 100% ولهذا اعتقدت ان جهازك موارده متوسطة فعذرا ويما ان ملفك يعمل على جهازي بكفاءة فقلت ربما السبب التنسيقات الشرطية او المعادلات والتي عددها اكثر من 28000 الامور كلها توقعات بسبب عدم حدوث اي مشكلة توقف او تجمد الملف معي عن طريق كود ارفقت لك الملف وفيه كود عد المعادلات وكود عد التنسيقات طبعا التنسيقات حاليا صفر لاته تم حذفها اذا كان السبب كثرة المعادلات فالامر يحناج الى تحويلها الى اكواد وللتاكد ان السبب منها قم بنسخ الورقة كلها ثم لصقها كقيم ثم جرب ملفك اذا انتهت المشكلة فالسبب المعادلات لك وافر التقدير والاحترام حسابات محطة النخلة_٠٩٤٩٥١.xlsm

وعليكم السلام ورحمة الله وبركاته اذا كانت مصادر جهازك منوسطة فالتنسيقات الشرطية + كثرة الالوان + المعادلات الكثيرة كفيلة ان تسبب النجمد لملفك شاهد الصورة كم معادلة وكم تنسيق شرطي في مبفك تم حذق التنسيق الشرطى من الورقة باكملها وعمل كود يقوم بتلوين الخلايا السالبة يوجد زر لعمل ذلك تبقى كثرة المعادلات جرب الملف ربما يكون به بعض التحسن حسابات محطة النخلة_٠٩٤٩٥١.xlsm

وعليكم السلام ورحمة الله وبركانه اولا لديك حساب المدة غير دقيق فمثلا 1/1/2024 - 31/12/2024 ليست 12 شهر ينقصها يوم وبكن يمكن اعتبارها 12 شهر 20-3-2024 - 31-12-2024 ليست 9 اشهر و37 يوم كما ورد في ملفك والصحيح 9 اشهر و11 يوم تم عمل كود يقوم بتوزيع المبلغ على عدد الاشهر وفي حالة وجود ايام مع الاشهر يدخلها قي توزيغ الميلغ حالات استنائية مثل حالة 11شهر و30 يوم سينم نوزيعها على 12 شهر هذا حسب قهمى لطلبك وانمنى ان يكون الملف المرفق فيه طلبك الكود Sub توزيع() Dim ws As Worksheet Dim startDate As Range, endDate As Range, amount As Range Dim i As Long, monthsDiff As Integer, extraDays As Integer Dim totalMonths As Integer, monthlyAmount As Double Dim colStart As Integer Range("H7:S12").ClearContents Set ws = ThisWorkbook.Sheets("ورقة1") Set startDate = ws.Range("D7:D" & ws.Cells(ws.Rows.Count, "D").End(xlUp).Row) Set endDate = ws.Range("E7:E" & ws.Cells(ws.Rows.Count, "E").End(xlUp).Row) Set amount = ws.Range("F7:F" & ws.Cells(ws.Rows.Count, "F").End(xlUp).Row) colStart = 8 For i = 1 To startDate.Rows.Count If IsDate(startDate.Cells(i, 1).Value) And IsDate(endDate.Cells(i, 1).Value) Then Dim startDt As Date, endDt As Date startDt = startDate.Cells(i, 1).Value endDt = endDate.Cells(i, 1).Value monthsDiff = DateDiff("m", startDt, endDt) If Day(endDt) < Day(startDt) Then monthsDiff = monthsDiff - 1 extraDays = Day(endDt) + (Day(DateSerial(Year(endDt), Month(endDt), 0)) - Day(startDt)) Else extraDays = Day(endDt) - Day(startDt) End If If extraDays >= 30 Then monthsDiff = monthsDiff + 1 End If If IsNumeric(amount.Cells(i, 1).Value) And amount.Cells(i, 1).Value > 0 Then If monthsDiff > 0 Then monthlyAmount = amount.Cells(i, 1).Value / monthsDiff Dim j As Integer For j = 0 To monthsDiff - 1 ws.Cells(i + 6, colStart + j).Value = monthlyAmount Next j Else ws.Cells(i + 6, colStart).Value = "" End If Else ws.Cells(i + 6, colStart).Value = "" End If Else ws.Cells(i + 6, colStart).Value = "" End If Next i End Sub جدول توزيع الاقساط.xlsm

السلام عليكم ارجو نحديد الاعمار التي تريد عدها هل تعنبر هذه الاعمار من ضمن 30 سنة اكبر من 29 الى اقل من 31 اذ كان كذلك استخدم المعادلة ويمكنك تعديل السن بها =COUNTIFS(E:E; "Female"; J:J; "Giza"; G:G; ">29"; G:G; "<31")

وعليكم السلام ورحمة الله وبركانه قم بفتح ملف احياء وشغل الكود ولا تفتح الملف الرئيسي الكود يقوم بفتحه واغلاقه اثناء تنفيذ الكود نفس الكود يطبق على الادارات الاخرى عند حفظ الملف احقظه xslb او xlsm لان الملف به كود مراعاة اسماء الصفحات موحدة بمعنى في الملف الرئيسي احياء يكون في ملف احياء اسم الشيت نفس الاسم الملف الرئيسي.xlsb احياء.xlsb

حسب طلبك بدون شاشات حوارية وغبرها يجب كنابة اسم الملف في الكود يالملف الاول وان يكون الملفان في نقس المسار جرب واعلمنى ان كان هنلك اي تعديل طبعا الملف 2 لا يوجد به تعديل الملف1.xlsb

وعليكم السلام ورحمة الله وبركاته تفضل الملفان كمثال الملف1.xlsb الملف2.xlsb

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

وعليكم السلام ورحمة الله وبركانه طلبك غير واضح بالنسبة لي هل تريد اخراجها بنفس الترتيب وما هي الارقام في الصف الثالت هل هي ارقام الاعمدة المطلوب استخراجها اكنب في AB:BO صفين او ثلاتة النتائج المتوقعة

السلام عليكم بعد اذن استاذنا الفاضل محمد هشام يالنسبة لسؤالك اضغط على Ctrl + Shift + Enter اطلعت على ملفك وما قام به الاستاذ محمد هشام كاقي ووافي ولكن التعامل مع معادلات الصفيف تحتاج الى من ينتبه بحذر عند استخذام الملف لان ضباع الاقواس معناها نتائج خاطئة ارفق لك ملفا بواسطة كود يعمل تلقائيا عند الاختيار من القائمة الى جانب يقوم بتحديث القائمة اذا اضفت لها بيانا جديدا او اكثر DC.xlsb

وعليكم السلام ورحمة الله وبركاته الكود عمله من A2 الى A1000 ويمكن التعديل من الكود جرب اكتب في اي خلية في العمود A عدا A1

وعليكم السلام ورحمة الله وبركانه لم نوضح لنا مكان كتابة النتائج النهائية وكيف ترغب شكلها النهائي في الملف العمود c كلمة نطايق نعنى ان لها مثيل في العمودين d-e وفي العمود f كلمة نطايق نعنى ان لها مثيل في العمودين A - B الكود Sub CompareTablesInOneSheet() Dim ws As Worksheet Dim lastRow1 As Long Dim lastRow2 As Long Dim i As Long Dim j As Long Set ws = ThisWorkbook.Sheets("ورقة1") lastRow1 = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row lastRow2 = ws.Cells(ws.Rows.Count, 4).End(xlUp).Row ws.Range("C2:C" & lastRow1).ClearContents ws.Range("F2:F" & lastRow2).ClearContents For i = 2 To lastRow1 For j = 2 To lastRow2 If ws.Cells(i, 1).Value = ws.Cells(j, 4).Value And ws.Cells(i, 2).Value = ws.Cells(j, 5).Value Then ws.Cells(i, 3).Value = "متطابق" ws.Cells(j, 6).Value = "متطابق" Exit For End If Next j If ws.Cells(i, 3).Value <> "متطابق" Then ws.Cells(i, 3).Value = "غير متطابق" End If Next i For j = 2 To lastRow2 If ws.Cells(j, 6).Value <> "متطابق" Then ws.Cells(j, 6).Value = "غير متطابق" End If Next j MsgBox "تم مقارنة البيانات بنجاح!" End Sub الملف Test.xlsb