نجوم المشاركات

هذه المشاركة قد تفيدك .

جرب الحل هذا =IIf([ID] Is Null; 0; Nz(DCount("[ID]"; "[count_c]"; "ID=" & [ID]); 0))

IsError تستخدم لفحص ما إذا كانت قيمة محددة تُعتبر خطأ أم لا. تُرجع هذه الدالة قيمة منطقية (True أو False) بناءً على وجود خطأ في القيمة المُقدمة لها. وبشكل عام يكون تنسيق الدالة كما يلي : If IsError(القيمة) Then ' التعامل مع حالة الخطأ Else ' التعامل مع القيمة بشكل طبيعي End If على سبيل المثال ، يمكن استخدامها للتحقق مما اذا كانت القيمة التي ستعود كجواب ( وظيفة أو عملية ) هي خطأ أم لا . كمثال على سبي الفرض :- Dim result As Variant result = SomeFunction() ' افتراضيًا، SomeFunction تعيد قيمة ما If IsError(result) Then MsgBox "حدث خطأ!" Else MsgBox "القيمة الصحيحة هي: " & result End If

الكاشير 7.xlsm

🌼 السلام عليكم ورحمة الله وبركاته 🌼 يسرني اليوم أن أقدم لكم الإصدار الثاني والمطور من الأداة المتميزة والرائعة ( الكاتب الذكي لدوال المجال ) . Dloockup, DCount, DMax, DMin, Dfirst, DLast هذه الأسطورة التي تقوم بكتابة دوال المجال نيابة عنك بشكل آلي .. :: ما هو الجديد :: اليوم أحتفل معكم بإصدار النسخة الثانية والمطورة لهذه الأداة والتي تتميز بالإضافات التالية : 1- إمكانية إضافة عدد لا نهائي من المعايير ( الشروط ). 2- التعرف التلقائي على نوع بيانات الحقول. 3- جلب قيمة المعيار من التقارير. 4- ميزة إضافة الأقواس حول المعايير. 5- حفظ بيانات آخر عملية قمت بها. 6- كتابة الدالة بمجرد الضغط على زر Enter. 7- تم إضافة أزرار لتسهيل كتابة الدالة NZ والمعامل Like. 8- تكبير لوحة الناتج بالضغط المزدوج عليها. 🌹🍀🌹🍀🌹 وهنا تم شرح هذه الإضافات بالتفصيل : :: شرح كيفية استخدام الأداة بالتفصيل :: :: 🌼 شكر وتقدير 🌼 :: لكل من ساهم برأي أو فكرة أو تطبيق في هذا العمل ، وجزاكم الله عن المسلمين كل خير 😊🌹 :: حمل الإصدار الثاني للكاتب الذكي لدوال المجال 2.0 :: ‏‏‏‏Domain Functions Builder V2.0.accdb

تفضل استاذ @ahmedabuzena محاولتي أضفت للاستعلام (customer account sub dollar Query) الحقل (BB) وسويته مصدر الحقل (موعد استحقاق الفاتورة) بالفورم طالع النتيجة ووافني بالرد . update invoices_2-1.rar

ولم الاعتذار ، والمكان يتسع للجميع البرنامج ممتاز ومليء بالافكار الجميلة جزاك الله خيرا وغفر لي ولك

حسب طلبك حضور وإنصراف_01.xlsb

وعليكم السلام -يمكنك بهذا https://stackoverflow.com/questions/67474397/alternative-of-filter-function-on-non-office-365

تم عمل بعض التعديلات الإضافية على البرنامج

الاخ الكريم @kkhalifa1960 اداءة رائعة فعلا اشتغلت معايا تمام جزاك الله خيرا

@kkhalifa1960 تمام استاذنا جزاك الله خيرا

تفضل أحي المرفق بعد التعديل ووافني بالرد . DCOUNT-1.rar

تفضل إن شاء الله فيه الإفادة

دالة لوضعها فى معادلة احتمال وجود خطأ فيها مثل عمليات القسمة او الضرب التى قد ينتج عنها خطأ لهذا توضع بهذا الشكل IsError(هنا_المعادلة_بتعتك)

Option Explicit Public Sub ColourChange() Dim Clé As Range For Each Clé In ActiveWorkbook.ActiveSheet.Range("C5:N400") Application.ScreenUpdating = False If Not IsError(Clé) Then With Clé .Interior.ColorIndex = xlColorIndexNone Select Case .Value2 Case "اخضر" .Interior.Color = RGB(0, 204, 0): .Font.Color = RGB(0, 204, 0) Case "ازرق" .Interior.Color = RGB(0, 0, 255): .Font.Color = RGB(0, 0, 255) Case "اصفر" .Interior.Color = RGB(255, 255, 0): .Font.Color = RGB(255, 255, 0) Case "احمر" .Interior.Color = RGB(255, 0, 0): .Font.Color = RGB(255, 0, 0) End Select End With End If Next Application.ScreenUpdating = True End Sub تلوين.xlsm

او Sub Filtre2() Dim wb As Workbook, ws As Worksheet, Dest As Worksheet Set wb = ThisWorkbook: Set ws = wb.Sheets("البيانات"): Set Dest = wb.Sheets("كشف حساب") Dim I&, Col&, ligne&, rng As Range Col = 1 ligne = ws.Cells(Rows.Count, Col).End(xlUp).Row Application.ScreenUpdating = False Dest.Range("A4:H100").ClearContents For I = 4 To ligne If ws.Cells(I, Col) = ws.[G1] And ws.Cells(I, Col + 2) >= Dest.[D2] And ws.Cells(I, Col + 2) <= Dest.[F2] Then Set rng = ws.Range(ws.Cells(I, 1), ws.Cells(I, 8)) Dest.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 8).Value = rng.Value End If Next I Application.ScreenUpdating = True End Sub

إخواني الكرام في المنتدى الغالي أقدم لكم اليوم موضوع ليس بالجديد ولكنه جد مفيد (جد .. يعني جداً أوك يا جدو) ..أقصد مفيد جداً الموضوع يتمحور ويتمركز حول معرفة الأرقام المفقودة أو الأرقام الناقصة في سلسلة أرقام .. إليكم الكود الأول المؤدي للغرض (هنا يشترط ترتيب الأرقام) ، مع شرح تفصيلي لأسطر الكود لتتمكن من التعديل عليه Sub MissingNumber_NumbersSorted() 'يقوم الكود بإظهار الأرقام الناقصة في تسلسل معين للأرقام ويشترط ترتيب الأرقام '------------------------------------------------------------------------- Dim SH As Worksheet Dim LR As Long Dim Text As String Dim I As Long, X As Long, XX As Long '[Sheet1] تخصيص المتغير ليساوي ورقة العمل المسماة Set SH = Sheets("Sheet1") 'تحديد آخر صف به بيانات في العمود الأول LR = SH.Cells(SH.Rows.Count, 1).End(xlUp).Row 'حلقة تكرارية بداية من الصف الخامس وحتى آخر صف به بيانات في العمود الأول For I = 5 To LR 'يساوي الفرق بين قيمة الخلية التالية وقيمة الخلية الحالية في الصف المحدد [X] المتغير X = Val(SH.Range("A" & I + 1)) - Val(SH.Range("A" & I)) '[X] استخدام الجملة الشرطية لناتج المتغير Select Case X 'إذا كان الفرق بين قيمة الخليتين أكبر من 1 يتم تنفيذ الحلقة التكرارية ما بين السطرين Case Is > 1 'حلقة تكرارية لتخزين الأرقام الناقصة For XX = 2 To X 'يساوي المتغير نفسه مع قيمة الخلية الحالية مضاف إليها قيمة المتغير في الحلقة التكرارية ناقص واحد ثم سطر جديد[Text]المتغير المسمى 'مثال لفهم هذا السطر '------------------- 'توجد القيمة 50012 [A15] توجد القيمة 50009 وفي الخلية [A14] في الخلية 'بما أن الفرق بين الخليتين يساوي 3 إذاً سيتم تنفيذ الحلقة التكرارية 'بداية الحلقة التكرارية 2 حيث أن رقم 2 هو أول رقم أكبر من واحد ، وفي مثالنا نهاية الحلقة التكرارية تساوي 3 'المتغير المفترض تخزين الأرقام الناقصة فيه عبارة عن سلسلة نصية فيتم إضافة النصوص التي سبق استخراجها ثم إضافة النصوص الجديدة 'الأرقام الناقصة تساوي قيمة الخلية الحالية 50009 في المثال مضافاً إليها قيمة الحلقة التكرارية والتي هنا تساوي 2 في بداية الحلقة التكرارية ليصبح الناتج 50011 ثم ناقص واحد لتحصل على أول رقم ناقص ألا وهو 5010 'يساوي 3 لتحصل في النهاية على الرقم التالي الناقص ألا وهو 5011[XX]مع الانتقال في الحلقة التكرارية يصبح المتغير Text = Text & Val(SH.Range("A" & I)) + XX - 1 & vbCrLf Next End Select Next 'رسالة لإظهار الأرقام الناقصة MsgBox Text, vbMsgBoxRtlReading End Sub وإليكم الكود الثاني وهو أقوى في أنه لا يشترط ترتيب الأرقام Sub MissingNumbers_YK_A() 'يقوم الكود باستخراج الأرقام الناقصة من سلسلة من الأرقام ولا يشترط ترتيب الأرقام '---------------------------------------------------------------------------- Dim InputRange As Range, OutputRange As Range, ValueFound As Range Dim LowerVal As Single, UpperVal As Single, Count_I As Single, Count_J As Single Dim NumRows As Long, NumColumns As Long Dim Horizontal As Boolean On Error GoTo ErrorHandler 'النطاق الذي يحتوي سلسلة الأرقام المراد استخراج الأرقام الناقصة منها Set InputRange = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row) LowerVal = WorksheetFunction.Min(InputRange) UpperVal = WorksheetFunction.Max(InputRange) Horizontal = False 'بداية النطاق الذي سيتم استخراج النتائج به Set OutputRange = Range("E2") NumRows = OutputRange.Rows.Count NumColumns = OutputRange.Columns.Count Application.ScreenUpdating = False If NumRows < NumColumns Then Horizontal = True NumRows = 1 Else NumColumns = 1 End If Count_J = 1 For Count_I = LowerVal To UpperVal Set ValueFound = InputRange.Find(Count_I, LookIn:=xlValues, LookAt:=xlWhole) If ValueFound Is Nothing Then If Horizontal Then OutputRange.Cells(NumRows, Count_J).Value = Count_I Count_J = Count_J + 1 Else OutputRange.Cells(Count_J, NumColumns).Value = Count_I Count_J = Count_J + 1 End If End If Next Count_I Application.ScreenUpdating = True Exit Sub ErrorHandler: End Sub كما تمت إضافة حل بمعادلات الصفيف لتؤدي نفس الغرض وإليكم أيضاً كود رائع للأخ الحبيب سليم حاصبيا مع شرح للأسطر ولا يشترط الترتيب للأرقام أيضاً Sub MissingNumbers_SALIM() 'يقوم الكود باستخراج الأرقام الناقصة في سلسلة أرقام ولا يشترط الترتيب '------------------------------------------------------------------ 'تعريف المتغيرات Dim Dico, D Dim C As Range, Rng As Range Dim B As Long, I As Long Dim MinVal As Double, MaxVal As Double 'النطاق المراد استخراج الأرقام الناقصة منه Set Rng = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row) 'سطر لايجاد أقل قيمة رقمية في النطاق MinVal = Application.WorksheetFunction.Min(Rng) 'سطر لايجاد أكبر قيمة رقمية في النطاق MaxVal = Application.WorksheetFunction.Max(Rng) 'مسح محتويات النطاق الذي سيتم استخراج النتائج به Range("G2", Range("G2").End(xlDown)).ClearContents 'إنشاء متغير من النوع كائن لتخزين الأرقام الناقصة به Set Dico = CreateObject("Scripting.Dictionary") 'حلقة تكرارية لكل الأرقام المسلسلة For I = 1 To (MaxVal - MinVal + 1) 'تعتمد هذه الأسطر على إضافة الرقم الناقص إلى الكائن المخصص لذلك If Application.WorksheetFunction.CountIf(Rng, MinVal + I - 1) = Then If Not Dico.Exists(MinVal + I - 1) Then Dico.Add (MinVal + I - 1), (MinVal + I - 1) End If Next I 'رقم صف البداية للنتائج في العمود السابع B = 2 'حلقة تكرارية لوضع القيم التي تم تخزينها في النطاق المحدد For Each D In Dico.items Range("G" & B) = D B = B + 1 Next D End Sub وعشان عيون أحبابي إليكم الكود الرابع وهو أفضل الأكواد من حيث أنه لا يشترط ترتيب الأرقام وأسطر الكود سهلة الفهم وسهلة التعامل معها Sub MissingNumbers_YK_B() 'يقوم الكود باستخراج الأرقام الناقصة في تسلسل للأرقام ولا يشترط الترتيب '------------------------------------------------------------------- 'تعريف المتغيرات Dim InputRange As Range Dim X As Long, lRow As Long 'تعيين النطاق الذي سيحتوي على سلسلة الأرقام المراد استخراج الأرقام الناقصة منها Set InputRange = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row) 'مسح محتويات النطاق الذي سيتم استخراج النتائج به Range("I2:I1000").ClearContents 'حلقة تكرارية من أقل قيمة بالنطاق لأكبر قيمة بالنطاق For X = WorksheetFunction.Min(InputRange) To WorksheetFunction.Max(InputRange) 'استخدام دالة البحث فإذا كانت القيمة المراد البحث عنها غير موجودة يعطي خطأ 'وبناءً على الخطأ يتم تنفيذ السطر التالي If IsError(Application.Match(X, InputRange, )) Then '[I] الرقم 2 هو رقم صف البداية في العمود '[I] يتم وضع الرقم الناقص في الخلية في الصف المحدد في العمود Cells(lRow + 2, "I") = X 'زيادة المتغير بمقدار واحد للانتقال لصف جديد لإدراج الأرقام الناقصة lRow = lRow + 1 End If Next X End Sub أترككم مع الملف المرفق ...للاستفادة بشكل عملي بالكود كان معكم أخوكم ياسر خليل أبو البراء YK (الموضوع مهدى للأخ الحبيب والأستاذ الكبير أسامة البراوي OB ومهدى للأخ الفاضل نايف - م) حمل الملف من هنا تقبلوا تحياتي

طيب ::::: الاستعلام الاول ::: تم عمله لحصر اسماء الدول المشاركة عن طريق استعلام تجميع الاستعلام الثاني :::: تم عمله لجميع المشاركين من كل دولة في كل فرع من فروع المسابقة ( والسبب لحصر اسم واحد للدولة في كل مشاركة .... لان بعض الدول مشاركة بأكثر من طالب في الفرع الواحد ) بهذا الشكل نحصل على اسم الدولة في الفرع فقط دون تكرار الاستعلام الثالث والاخير :::: تم عمل استعلام تجميع لفروع المسابقة لحصر عدد الدول المشاركة في كل فرع ,,, وهو ما تم ربطه بالنموذج هذه طريفة بدون استعلام ظاهر جعلنا الاستعلامات مخفية في استعلام النموذج ....... Rac.accdb

حسناً يجب أخذ في عين الإعتبار وجود نفس القيمة مكررة في أكثر من خلية مع أني لا أعتقد ذلك بحسب المعادلة التي وضعها السيد مشعل لكن بكل الأحوال ممكن تجربة هذا الكود Sub test() Dim i& Dim x As String Dim r As Range Application.ScreenUpdating = False Range("A1:AI35").Interior.Color = xlNone For i = 14 To 15 With Range("A1:AI35") Set r = .Cells.Find(Range("AL" & i), , , 1) x = r.Address Do r.Interior.Color = vbRed Set r = .Cells.FindNext(r) Loop Until r.Address = x End With Next Application.ScreenUpdating = True End Sub 'وأيضاً لتلوين كل رقم بلون مختلف Sub test2() Dim i& Dim x As String Dim r As Range Dim f As Boolean Application.ScreenUpdating = False Range("A1:AI35").Interior.Color = xlNone For i = 14 To 15 With Range("A1:AI35") Set r = .Cells.Find(Range("AL" & i), , , 1) x = r.Address Do r.Interior.Color = IIf(f, vbRed, vbYellow) Set r = .Cells.FindNext(r) Loop Until r.Address = x End With f = True Next Application.ScreenUpdating = True End Sub

بالاذن من الاستاذ محمد هشام. طريقة أخرى Sub test() Range("A1:AI35").Interior.Color = xlNone For I = 14 To 15 Range("A1:AI35").Cells.Find(Range("AL" & I), , , 1).Interior.Color = vbRed Next End Sub

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

وعليكم السلام 🙂 تحتاج ان تعمل مجلد آمن : جعفر

تفضل اخى الكريم هناك دالة معرفة تسمى CLEANup واليك الملف وبه كود الدالة المعرفة دالة معرفة لحذف التشكيل من النص.xlsm

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