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

وعليكم السلام ورحمة الله وبركاته لم التزم بالفورم الذي ارفقته واقدم لك فورم يؤدى نفس المهمة شاشة دخول 123.xlsm

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

ركز معى قليلا اخي اولا - ملفك قمت بتجربتة واضفنا اكثر من صف ولم تأتي اي رسالة فملفك سليم ولا توجد مشكلة كما جربه استاذنا حسونة حسن واخبرك انه لا مشكلة في الملف ثانيا - الرسالة في وادى وملفك في واد اخر بمعنى الرسالة تتكلم عن مشكلة في محتوى الملف ‘1.xlsm وملفك هنا ليس بنفس الاسم ابحث في جهازك عن ملف باسم 1.xlsm وارفقه هنا في الموضوع فربما ملفك مرتبط بهذا الملف ولكي تتاكد جرب الملف على جهاز اخر لتتأكد من كلامنا موفق دائما

بعد اذن استاذنا الفاضل محمد هشام كذلك كود الاستاذ العلامة عبدالله باقشيرلا يتعامل مع اسماء اخرى مثل المعتصم بالله الواثق بالله ام كلثوم ام احمد ام الخير ام الهناء واحيانا بالهمز واحيانا لا وغيرها من الاسماء والقاعدة هي اظافة الاسم الثابت بمعنى مثلا فاطمة الزهراء فنضيف الى الكود الزهراء فقط لانه ثابت واي اسم ياتي قبل الزهراء سيتعامل معه الكود كذلك نور الهدى او سيف الهدى فنضيف الى الكود اسم الهدى فقط وهكذا كذلك يمكنك اظافة اي اسم اد جد اسم جديد تعديل الكود Function Father_Name(Name As String, Optional x As Integer = 2) As String Dim K As String Dim S As String Dim N As Integer Dim d As Integer Dim M As Integer Dim r As Integer K = Trim(Name) M = Len(K) S = " " If InStr(1, K, S, 1) = 0 Then Father_Name = "" Exit Function End If If x > 1 Then N = 1 For r = 2 To x d = InStr(N, K, S, 1) + 1 If d = 1 Then Father_Name = "" Exit Function End If N = d Next d = InStr(N, K, S, 1) + 1 If d = 1 Then Father_Name = "" Exit Function End If Father_Name = Mid(K, d, M) Else N = InStr(1, K, S, 1) + 1 d = InStr(N, K, S, 1) + 1 If d = 1 Then Father_Name = "" Exit Function End If If Mid(K, 1, 4) = "عبد " Or _ Mid(K, 1, 4) = "أبو " Or _ Mid(K, 1, 4) = "ابو " Or _ Mid(K, N, 5) = "الله " Or _ Mid(K, N, 6) = "الدين " Or _ Mid(K, 1, 5) = "الهدى " Or _ Mid(K, 1, 6) = "كلثوم " Or _ Mid(K, 1, 7) = "الزهراء " Or _ Mid(K, 1, 3) = "أم " Or _ Mid(K, 1, 2) = "ام " Or _ Mid(K, N, 5) = "بالله " Then Father_Name = Mid(K, d, M) Else Father_Name = Mid(K, N, M) End If End If End Function الملف استخراج اسم الاب من الاسم المركب1.xlsm

وعليكم السلام ورحمة الله وبركاته اتمنى ان يكون طلبك في هذا الملف test1.xlsm

الفكرة تم تطبيقها على ملف توزيع الطلاب.xlsb

هذه الرسالة تعني أن برنامج Excel وجد مشكلة في محتوى الملف ‘1.xlsm’ ويعرض عليك محاولة استعادة أكبر قدر ممكن من البيانات. هذا قد يحدث بسبب تلف في الملف أو مشكلة في البيانات المخزنة داخله. لحل هذه المشكلة، يمكنك اتباع الخطوات التالية: محاولة الاستعادة: اضغط على “Yes” عندما تظهر الرسالة للسماح لـ Excel بمحاولة إصلاح الملف. فتح الملف في وضع القراءة فقط: إذا لم تنجح المحاولة الأولى، حاول فتح الملف في وضع القراءة فقط ونقل المحتويات إلى ملف جديد.

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

المعادلة =SUMPRODUCT(SUMIFS(RawMaterials!$C$2:$C$20; RawMaterials!$B$2:$B$20; ProductionMode!$B3:$B9); ProductionMode!C3:C9) الملف officena1.xlsb

السلام عليكم ورحمة الله وبركاته حسب وصفك للامر انت تحتاج الى كود ليقوم بالمهمة جرب واخبرنى بالنتيجة الكود Sub CalculateProductionCost() Dim wsRaw As Worksheet Dim wsProd As Worksheet Dim lastRowRaw As Long Dim lastRowProd As Long Dim i As Long, j As Long Dim materialName As String Dim materialCost As Variant Dim totalCost As Double Dim materialCosts As Object Dim prodValues As Variant Set wsRaw = ThisWorkbook.Sheets("RawMaterials") Set wsProd = ThisWorkbook.Sheets("ProductionMode") lastRowRaw = wsRaw.Cells(wsRaw.Rows.Count, "B").End(xlUp).Row lastRowProd = wsProd.Cells(wsProd.Rows.Count, "B").End(xlUp).Row Set materialCosts = CreateObject("Scripting.Dictionary") For i = 2 To lastRowRaw materialName = wsRaw.Cells(i, 2).Value materialCost = wsRaw.Cells(i, 3).Value If IsNumeric(materialCost) Then materialCosts(materialName) = materialCost End If Next i prodValues = wsProd.Range("B2:K9").Value For j = 3 To 11 totalCost = 0 For i = 1 To 8 materialName = prodValues(i, 1) If materialCosts.exists(materialName) And IsNumeric(prodValues(i, j - 1)) Then totalCost = totalCost + (prodValues(i, j - 1) * materialCosts(materialName)) End If Next i wsProd.Cells(12, j).Value = totalCost Next j End Sub الملف officena.xlsb

وعليكم السلام ورحمة الله وبركاته المعادلة التالية تتعامل في حالة اختلاف الصفوف =SUMPRODUCT((RawMaterials!$B$2:$B$20=INDEX(ProductionMode!$B$3:$B$9; ROW(ProductionMode!$B$3:$B$9)-ROW(ProductionMode!$B$3)+1))*(RawMaterials!$C$2:$C$20)*INDEX(ProductionMode!C3:C9; ROW(ProductionMode!C3:C9)-ROW(ProductionMode!C3)+1))

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

او هذا الكود تأكد من أن مكتبة DAO مفعلة في مشروعك. يمكنك تفعيلها من خلال الذهاب إلى Tools > References في محرر VBA، ثم التأكد من تفعيل Microsoft DAO 3.6 Object Library Private Sub Form_Open(Cancel As Integer) Dim tb As DAO.Recordset ' التأكد من استخدام DAO Recordset Set tb = CurrentDb.OpenRecordset("tbl_student1", dbOpenDynaset) tb.MoveFirst Do While Not tb.EOF tb.Edit ' وضع السجل في وضع التحرير tb.Fields("OnlyYou") = False ' تعديل قيمة الحقل tb.Update ' تحديث السجل في قاعدة البيانات tb.MoveNext ' الانتقال للسجل التالي Loop tb.Close ' إغلاق الكائن بعد الاستخدام Set tb = Nothing ' إلغاء الإشارة إلى الكائن End Sub

ان لم ينجح الامر جرب الكود التالي تأكد من أن مكتبة DAO مفعلة في مشروعك. يمكنك تفعيلها من خلال الذهاب إلى Tools > References في محرر VBA، ثم التأكد من تفعيل Microsoft DAO 3.6 Object Library Private Sub Form_Open(Cancel As Integer) Dim tb As DAO.Recordset Set tb = CurrentDb.OpenRecordset("tbl_student1", dbOpenDynaset) If Not tb.BOF And Not tb.EOF Then tb.MoveFirst Do While Not tb.EOF tb.Edit tb.Fields("OnlyYou").Value = False tb.Update tb.MoveNext Loop End If tb.Close Set tb = Nothing End Sub

الملف يشتغل معى جيدا على الاوفيس 2016 وليس لدي اوفيس 2003 لكي اجرب جرب الدخول References اي واحدة مؤشر عليها باسم MISSING الغ التاشير ثم موافق وكنصيحة حاول ترقية الاوفيس لديك الى اصدار احدث

اقفل الملف وافتحه من جديد وادخل مباشرة الى References ستجدها مفعلة

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

تفضل الشرح بالتفصيل الشرح استعنت بالذكاء الاصطناعي الهدف من هذا الكود هو البحث عن اسم معين في ورقة عمل تسمى “السجل” وعند العثور عليه، نسخ مجموعة من البيانات المرتبطة بهذا الاسم إلى ورقة عمل أخرى تسمى “استدعاء”. إليك الخطوات الرئيسية التي يقوم بها الكود لتحقيق هذا الهدف: مراقبة التغييرات في الخلية B6 في ورقة “استدعاء”. البحث عن الاسم المدخل في الخلية B6 داخل العمود B في ورقة “السجل”. نسخ البيانات المرتبطة بالاسم الموجود في ورقة “السجل” إلى مواقع محددة في ورقة “استدعاء”. إذا تم العثور على الاسم، يتم نسخ البيانات إلى الصفوف 9، 12، 15، و18 في ورقة “استدعاء”. إذا لم يتم العثور على الاسم، يتم عرض رسالة تفيد بأن الاسم غير موجود في السجل If Not foundCell Is Nothing Then هذا السطر يتحقق مما إذا كانت الخلية foundCell تحتوي على قيمة أم لا. إذا كانت foundCell تحتوي على قيمة، فهذا يعني أن الاسم الذي تم البحث عنه قد تم العثور عليه في العمود B في الورقة “السجل”. إذا لم يتم العثور على الاسم، فإن foundCell ستكون Nothing. نسخ البيانات إلى الصف 9: data = wsSource.Range(foundCell.Offset(0, 1), foundCell.Offset(0, 10)).Value wsTarget.Range("A9:I9").Value = data foundCell.Offset(0, 1) تعني الانتقال من الخلية التي تم العثور عليها بمقدار عمود واحد إلى اليمين. foundCell.Offset(0, 10) تعني الانتقال من الخلية التي تم العثور عليها بمقدار 10 أعمدة إلى اليمين. يتم نسخ البيانات من العمود الثاني إلى العمود الحادي عشر في الصف الذي تم العثور فيه على الاسم إلى الصف 9 في الورقة “استدعاء”. نسخ البيانات إلى الصف 12: data = wsSource.Range(foundCell.Offset(0, 10), foundCell.Offset(0, 19)).Value wsTarget.Range("A12:I12").Value = data foundCell.Offset(0, 10) تعني الانتقال من الخلية التي تم العثور عليها بمقدار 10 أعمدة إلى اليمين. foundCell.Offset(0, 19) تعني الانتقال من الخلية التي تم العثور عليها بمقدار 19 عمودًا إلى اليمين. يتم نسخ البيانات من العمود الحادي عشر إلى العمود العشرين في الصف الذي تم العثور فيه على الاسم إلى الصف 12 في الورقة “استدعاء”. نسخ البيانات إلى الصف 15: data = wsSource.Range(foundCell.Offset(0, 19), foundCell.Offset(0, 28)).Value wsTarget.Range("A15:I15").Value = data foundCell.Offset(0, 19) تعني الانتقال من الخلية التي تم العثور عليها بمقدار 19 عمودًا إلى اليمين. foundCell.Offset(0, 28) تعني الانتقال من الخلية التي تم العثور عليها بمقدار 28 عمودًا إلى اليمين. يتم نسخ البيانات من العمود العشرين إلى العمود التاسع والعشرين في الصف الذي تم العثور فيه على الاسم إلى الصف 15 في الورقة “استدعاء”. نسخ البيانات إلى الصف 18: data = wsSource.Range(foundCell.Offset(0, 28), foundCell.Offset(0, 38)).Value wsTarget.Range("A18:I18").Value = data foundCell.Offset(0, 28) تعني الانتقال من الخلية التي تم العثور عليها بمقدار 28 عمودًا إلى اليمين. foundCell.Offset(0, 38) تعني الانتقال من الخلية التي تم العثور عليها بمقدار 38 عمودًا إلى اليمين. يتم نسخ البيانات من العمود التاسع والعشرين إلى العمود الثامن والثلاثين في الصف الذي تم العثور فيه على الاسم إلى الصف 18 في الورقة “استدعاء”. إذا لم يتم العثور على الاسم: Else MsgBox "الاسم غير موجود في السجل." End If إذا لم يتم العثور على الاسم، يتم عرض رسالة تفيد بأن الاسم غير موجود في السجل

وعليكم السلام ورحمة الله وبركاته الكود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$B$6" Then Application.ScreenUpdating = False Dim wsSource As Worksheet Dim wsTarget As Worksheet Dim nameToFind As String Dim foundCell As Range Dim data As Variant Set wsSource = ThisWorkbook.Sheets("السجل") Set wsTarget = ThisWorkbook.Sheets("استدعاء") nameToFind = wsTarget.Range("B6").Value Set foundCell = wsSource.Range("B:B").Find(What:=nameToFind, LookIn:=xlValues, LookAt:=xlWhole) If Not foundCell Is Nothing Then data = wsSource.Range(foundCell.Offset(0, 1), foundCell.Offset(0, 10)).Value wsTarget.Range("A9:I9").Value = data data = wsSource.Range(foundCell.Offset(0, 10), foundCell.Offset(0, 19)).Value wsTarget.Range("A12:I12").Value = data data = wsSource.Range(foundCell.Offset(0, 19), foundCell.Offset(0, 28)).Value wsTarget.Range("A15:I15").Value = data data = wsSource.Range(foundCell.Offset(0, 28), foundCell.Offset(0, 38)).Value wsTarget.Range("A18:I18").Value = data Else MsgBox "الاسم غير موجود في السجل." End If Application.ScreenUpdating = True End If End Sub الملف كود استدعاء بيانات1.xlsm

وعليكم السلام ورحمة الله وبركاته الكود Sub CountIfToColumnH() Dim ws As Worksheet Dim lastRow As Long Dim i As Long Set ws = ThisWorkbook.Sheets("Sheet1") lastRow = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row For i = 2 To lastRow ws.Cells(i, "H").Value = Application.WorksheetFunction.CountIf(ws.Range("G$2:G" & i), ws.Cells(i, "G").Value) Next i End Sub الملف TEST COUNTIF.xlsb

السلام عليكم ورحمة الله وبركاتة اليك الحل المعادلة =IF(I2="";"";AGGREGATE(14;6;E$2:E$100/(F$2:F$100=I2);1)) الملف Book2.xlsx

وعليكم السلام ورحمة الله وبركاته ارجو كتابة النتائج المتوقعة في صفحة تقرير شامل ولو خمسة صفوف حتى يتم بناء الكود على النتائج المتوقعة وخاصة ان الصفحتان 1 و2 تختلفان في اغلب البيانات

وعليكم السلام ورحمة الله وبركاته الزر الاخير الحذف ملغي لان الز رين انشاء صفحة وزر فصل المرتب يقومان بحذف الصفحات قبل انشائها في كل ضغظة على الزر && الاستعلام باي كلمة من الجدول وعند الضغظ على زراستغلام ينقلك الى الكلمة التي تبحث عنها مع تلوينها وتكون كتابة كلمة البحث في الخلية B1 الموظفين.xlsb

بارك الله فيك استاذنا الفاضل محمد هشام على الافادة (وَقُل رَّبِّ زِدْنِي عِلْمًا)

وعليكم السلام ورحمة الله تعالى وبركاته بعد اذن استاذنا الفاضل محمد هشام ,حل لكل الخيارات وان لم يطلبها صاحب الموضوع الكود Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim wsDashboard As Worksheet Dim wsMain As Worksheet Dim rng As Range Dim count As Long Dim filterValue As String Set wsDashboard = ThisWorkbook.Sheets("لوحة المعلومات") Set wsMain = ThisWorkbook.Sheets("الرئيسية") Select Case Target.Address Case wsDashboard.Range("C17").Address filterValue = "تحت الاجراء" Case wsDashboard.Range("D17").Address filterValue = "في الانتظار" Case wsDashboard.Range("F17").Address filterValue = "مكتمل" Case wsDashboard.Range("G17").Address filterValue = "محالة" Case wsDashboard.Range("H17").Address filterValue = "معلق / مؤجل" Case Else Exit Sub End Select wsMain.Activate If wsMain.AutoFilterMode Then wsMain.AutoFilterMode = False End If wsMain.Range("A1").AutoFilter Field:=10, Criteria1:=filterValue Set rng = wsMain.Range("J2:J" & wsMain.Cells(wsMain.Rows.count, "J").End(xlUp).Row) count = Application.WorksheetFunction.CountIf(rng, filterValue) If count > 0 Then MsgBox "عدد الطلبات التي تحتوي على '" & filterValue & "' هو: " & count Else MsgBox "لا توجد طلبات تحتوي على '" & filterValue & "'." End If End Sub الملف ملف ادارة طلبات1.xlsb