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

السللام عليكم 
التغيير من السبنر المرتبط بالخلية J2 
ثانوية عامة.xlsm

السلام عليكم
جرب الكود 
Sub تلوين_المكرر() Dim ws As Worksheet, rng As Range, cell As Range Dim dict As Object, lastRow As Long Dim r As Long, c As Long, key As String Set ws = ActiveSheet lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row If lastRow < 5 Then lastRow = 5 Set rng = ws.Range("A5:J" & lastRow) rng.Interior.ColorIndex = xlNone Application.ScreenUpdating = False For r = 5 To lastRow For c = 1 To 10 Set cell = ws.Cells(r, c) If Not IsError(cell.Value) And Len(cell.Value) > 0 Then key = Trim(cell.Value) Set dict = CreateObject("Scripting.Dictionary") For Each c2 In ws.Range(ws.Cells(r, 1), ws.Cells(r, 10)) If c2.Value = key Then dict(key) = dict(key) + 1 Next If dict(key) > 1 Then cell.Interior.Color = vbRed: GoTo NextCell ' التحقق عموديًا dict.RemoveAll For Each r2 In ws.Range(ws.Cells(5, c), ws.Cells(lastRow, c)) If r2.Value = key Then dict(key) = dict(key) + 1 Next If dict(key) > 1 Then cell.Interior.Color = vbRed End If NextCell: Next c Next r Application.ScreenUpdating = True End Sub  

السلام عليكم
حقيقة الدحول الى الموقع اصبح بالصدفة قليل ما تجدة يعمل
 الكود سليم والمشكلة في تنسيق الأرقام قي صفخة table  في العمودين  b& e  اذا اردتها بالأرقام العربية حسب ملفك فقم بتنسيقها الى [$-,201]# وان اردتها بالأرقام الغربية اجعل النتسيق رفم بدون خانات عشرية

 
 
ملف بتنسيق الارقام العربية [$-,201]#
مراقبة ثانوية 2026.xlsm
ملف بتنسيق الارقام الغربية 
مراقبة ثانوية1 2026.xlsm

وعليكم السلام ورحمة الله وبركاته
InputBox في VBA لا يدعم إخفاء النصوص أو إظهارها كنجوم بشكل مباشر. الحل هو استخدام UserForm مع TextBox خاصية PasswordChar
طباعة.xlsm

الاسهم في  ملفك  لم تشمل الاحتياطي 
اليك الملف 
تكملة1 مراقبة 2026.xlsm

اليك ما طلبت بالتنسيق الشرطي
 
aaaa2.xlsm

وعليكم السلام ورحمة الله وبركاته
جرب الكود في الملف المرفق
1الجرد.xlsm

اعلم هذا  وواضح بالملف  وعملت في قطاع التعليم التقني والتوجيه الفني 39 سنة  واعلم جيدا كيف عمل اللجان
لم يكن الامر يتطلب كل هذا 
على كل حال  عودة للملف
 اليك الملف بالتعديل الاخير 
 
 
 
مراقبة_ تحويل اللجان الى أسماء.xlsm

السلام عليكم ورحمة الله وبركاته 
الان وضحت الفكرة بارك الله فيك
 تم عمل كمبوبوكس به اسماء الموظفين 
الازار  المرقمة قي القورم اكوادها موحودة  كما هي  اعتقد بعد الكمبوبوكس لم تعد في حاجة اليها 
ان اردت الغائها فابلعنى
جرب الملف وان كنت تحتاج الى تعديل  في الفورم فابشر 
تحياتى لك
حضور وخروج موظفين.xlsm 4495.xlsm

وعليكم السلام ورحمة الله وبركاته
جرب هذا 
تسلسل ملئ بيانات الفورم1.xlsm

السلام عليكم 
لم توضخ خلية البحث G1 لها علاقة بالتوزيع ام لا فيكون التوزيع فردي ام للكل 
على كل حال الملف فيه عدد 2 شيت
الاول شيت DATA يقوم بالتوزيع الفردي للمراقب وذلك بالاختيار من الخلية G1 
الثاني شيت DATA1 به كود يقوم بتوزيع اللجان على كل المراقبين 
جرب الملف المرفق متمنيا ان يكون فيه طلبك
 ملاحظة1_2026.xlsm

وعليكم السلام ورحمة الله وبركاته
سبب الخطا عدم وجود رابط بين اللست والشيت
في الكود يوجد عمود مخفى في ListBox وهو الرابط بين الاختيار من اللست والشيت  يعنى الاعمدة 10 للشيت +عمود مخفي في اللست =11
تم التعديل والغاء العمود المخفي في اللستبكس واستخذام مصفوفة تربط كل صف في الـ ListBox برقم الصف الحقيقي في الشيت.
اليك الملف
ليست بوكس 4.xlsm
 

وعليكم السلام ورحمة الله وبركانه
بعد اذن استاذنا الفاضل  عبدللرحيم
الاستاذ مستر أيسم ان اردت الحل بالمعادلات فالاستاذ عبدالرحيم  حله وافي وكافي
اذا اردت الامر بالكود بحيت يجلب المواد والفصول تلقائيا زادات ام تقصت فاليك الملف 
جمع بشرطين.xlsb

وعليكم السلام ورحمة الله وبركاته
الى جانب الحلول التي ارفقها  استاذنا الفاضل hegazee اليك  حل اخر بالكود في حدث الورقة
Private Sub Worksheet_Change(ByVal Target As Range) Dim rngF As Range, rngG As Range Dim rngB As Range, rngC As Range Dim pos As Variant Set rngF = Me.Range("F2") ' Set rngG = Me.Range("G2") Set rngB = Me.Range("B2:B1000") Set rngC = Me.Range("C2:C1000") If Not Intersect(Target, rngF) Is Nothing Then Application.EnableEvents = False pos = Application.Match(rngF.Value, rngB, 0) If Not IsError(pos) Then rngG.Value = Application.Index(rngC, pos) Else rngG.Value = "" End If Application.EnableEvents = True End If rngG.Select End Sub data.xlsb

السلام عليكم ورحمة الله وبركاته
تم تحسين سرعة الكود
اي تغيير في I2 -13-14 يعمل الكود
الترقيم التلقائي في العمود B 
تم تعديل المعادلة في العمود الاخير بحيت  تظعر الارقام حيب اخر بيان في العمود C
جرب  الكود وان كان هناك أي استفسار فلا حرج
اعاده الله عليك يالخير والبركة
يومية النقدية 1العامة.xlsm

عذرا لم انتبه ان قي طلبك طباعة متعددة
الطريقة الاولى  زر print all اكتب كود الشركة بداية الطباعة  في الخلية P2 ونهاية الطباعة في Q2
الطريقة السابقة لطباعة الارقام المتسلسلة وراء بعضها
الطريقة الثانية عن طريق فورم  زر طباعة خسب الاختيار وهي تغنيك عن كل الازرار  وعن الطريقة الاولى حيث يمكن
الطباعة لموظف واخد  او الطباعة للكل او الطباعة المتعددة خسب الاختيار  سواء الارقام متصلة ام منفصلة
اختر ما تراه متاسب لطلبك
 
مرتبات شركة نقل البضائع فنيين عن شهر نوفمبر 2025 (1).xlsm

السلام عليكم
نعم الان اتضح المطلوب   بارك الله فيك
الحل تم حذف النطاق من ادارة الاسماء فصل شيفت'!$A$8:$R$283 من ادارة الاسماء وجعلنا النطاق مباشرة في الكود فاصبح الكود 
بهذا 
Sub filter_D() Dim Q1 As String Dim rng As Range Set rng = Sheets("فصل شيفت").Range("$A$8:$R$283") Q1 = Sheets("فصل شيفت").Range("A7").Value If Q1 = "" Then rng.AutoFilter Else Q1 = "*" & Q1 & "*" rng.AutoFilter Field:=1, Criteria1:=Q1, Operator:=xlOr, Criteria2:="=" End If End Sub نموذج حركة جرديوميه 15-11.xlsm

اولا شكرا لدعاؤك لي 
 ثانيا الكود في الملف السابق يقوم بترتيب الصفحات ذات الارقام وبالتالي ستجد الصفحات الاخرى ذات الحروف وليس الارقام مستثناة  وتجدها بجانب بعضها
ولكن هناك احتمال الرغبة في استثناء صفخة او صفحات رقمية مثلا تريد استثناء صفخة 4 من الترتيب . هنا سيتم التعديل على الكود باظافة مصفوفة لتجميع الصفخات المستثناة
كل ما عليك فعلة هو التعديل في هذا الجزء من الكود  حيث اضفت لك صفحات افتراضية في الكود وليس في المصتف  مثل "ملخص", "إعدادات", "تعليمات يمكنك تعديلها باي اسم او اظافة صفحات اخرى باي عدد تشاء
excludedSheets = Array("الرييييسية", "تجميع", "ملخص", "إعدادات", "تعليمات") اليك الملف بالتعديل
ترتيب الصفحات1.xlsm
تحياتي

السلام عليكم
خسب المثال المرفق
يبدو أنك تريد دالة للتقريب إلى أقرب 0.1 (أعشار)، وليس معادلة باقي القسمة (mod) التي تعمل عادة مع الأعداد الصحيحة.
=CEILING(A2; 0.1) =ROUNDUP(A2*10;0)/10 تقريب.xlsx

وعليكم السلام ورحمة الله وبركاته 
=IFERROR(AGGREGATE(15;6;A4:A30;ROW($A$1));"") السبب الرئيسي هو أن ROW($A$1) ثابت دائماً  وكذلك النطاق يجب ثتبيته بحيث لا يتغير عند السحب ليصبح A$4:A$30 بدل A4:A30
ولحل المشكلة  اختر احدى المعادلات
=IFERROR(AGGREGATE(15;6;A$4:A$30;ROW(A1)-ROW(A$1)+1);"") =IFERROR(AGGREGATE(15;6;$A$4:$A$30;ROW(A1));"") =IFERROR(AGGREGATE(15;6;$A$4:$A$30;ROW(A1:A1));"") =IFERROR(AGGREGATE(15;6;$A$4:$A$30;ROW(A4)-ROW($A$4)+1);"") اليك الملف وبه تطبيق المعادلات الاربعة السابقة
ntega_elec_new.xlsb
 

وعليكم السلام ورحمة الله وبركاته
قمت ياستبدال اللستبوكس بالورقة باخر في يوزرفورم
فكرة العمل
انقر على الخلية المراد وضع الوظيفة بها في العمود B يظهر الفورم قم بالاختيار  ويختفى الفورم عند النقر في اي خلية اخرى
لك وافر الاحترام والتقدير
LISTBOX1.xlsm
 

السلام عليكم ورحمة الله وبركاته
ساقدم لك ملف خسب ما فهمته من ردك  
راجع الملف واذا كانت هناك قيم غير صحيحة  فقم  بارفاق جدول به القيم الصحيحة يدويا وبدون معادلات  للراتب والسلفيات لعدد 3 او 4 اشخاص  
اليومية (2).xlsm

وعليكم السلام ورحمة الله وبركاته
المشكلة الرئيسية  هي في منطق البحث
 
البحث عن الأعمدة يتم من الصف 3 (G3:U3) ولكن البيانات تبدأ من الصف 4
الإزاحة (offset) غير صحيحة عند استخراج القيم
اليك التعديل
تنسيق ترتيب الجداول الكمية مع اسم الصنف مع التاريخ التابع له - Copy - Copy.xlsm
 

السلام عليكم
جرب الملف 
TRIP_01 (1) (2).xlsx
 

السلام عليكم
استبدل هذا
Private Sub UserForm_Initialize() Call showinlistbox End Sub بهذا
Private Sub UserForm_Initialize() TextBox25 = Val(Sheets("table").Cells(Rows.Count, 1).End(xlUp).Value) Call showinlistbox End Sub   TextBox25 = Val(Sheets("table").Cells(Rows.Count, 1).End(xlUp).Value)