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

السلام عليكم
حسب ما فهمته من طلبك المعادلة التالية تلبى المطلوب 
ضع المعادلة في l2 ثم اسحبها الى اسفل
=IFERROR(VLOOKUP(K2; $O:$P; 2; FALSE); "")  

السلام عليكم ورحمة الله وبركاته
حل بالكود وان  اضفت مواد احرى عدل النطاق في الكود
Sub ProcessAndSumData() Dim wsB As Worksheet Set wsB = ThisWorkbook.Sheets("B") Application.ScreenUpdating = False With wsB .Range("B10:I12").ClearContents With .Range("B10:I10") .FormulaR1C1 = "=IFERROR(SUMPRODUCT((A!R3C1:R1828C1=R6C3) * (ISNUMBER(INDEX(A!R3:R1828,0,MATCH(R8C,A!R1,0)))) * (INDEX(A!R3:R1828,0,MATCH(R8C,A!R1,0))>=60)),""/"")" .Value = .Value End With With .Range("B11:I11") .FormulaR1C1 = "=IFNA(SUMPRODUCT((INDEX(A!R3:R1828,0,MATCH(R8C,A!R1,0))<60) * ISNUMBER(INDEX(A!R3:R1828,0,MATCH(R8C,A!R1,0))) * (A!R3C1:R1828C1=R6C3)),""/"")" .Value = .Value End With With .Range("B12:I12") .FormulaR1C1 = "=SUM(N(R[-2]C), N(R[-1]C))" .Value = .Value End With End With Application.ScreenUpdating = True End Sub لا تنس تفعيل الماكرو
aa2.xlsb
 

وعليكم السلام ورحمة الله وبركاته
حسب فهمى لطلبك انك تقصد بالعمود الثالت  العمود A 
يناء   عليه اليك معادلة صعها بداية من D2 ثم اسحبها لاسفل  او ضغها في عمود بداية من الصف2
=INDEX($B$2:$B$500;MATCH(A2; $C$2:$C$500; 0))  ارجو ان يكون في ردي ما يفيد
تحياتي

وعليكم السلام ورحمة الله وبركاته
جرب الملف واعلمنى بالنتيجة
ملف الحجز.xlsb

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

ربما  يكون احد الاسباب  وكما احبرتك في ردي الاحير باننى لست جازما وحصوصا ان الملف في مشاركتك الاولى يعمل لدي وكذلك حسب استاذتا  Foksh ان الملف يعمل لديه
وربما يكون مسار سطح المكتب هو السبب
تم تعديل الكود وسيطلب منك مكان حفظ الملف احتر اي مكان 
جرب واعلمنى بالنتائج
مرتب +عمولة السائقين (2).xlsm
 

نعم الامر هكذا واضح وقمت بحذف التعليق السابق لعدم اهميته بعد ارفاق ملفك الاخير وبه التوضيح
جرب الكود  
Sub تجميع() Dim ws As Worksheet Dim آخرصف As Long Dim c As Long, r As Long Dim صف_الاخراج As Long Set ws = ActiveSheet صف_الاخراج = 1 ws.Columns(16).ClearContents For c = 1 To 13 آخرصف = ws.Cells(ws.Rows.Count, c).End(xlUp).Row For r = 1 To آخرصف If ws.Cells(r, c).Value <> "" Then ws.Cells(صف_الاخراج, 16).Value = ws.Cells(r, c).Value صف_الاخراج = صف_الاخراج + 1 End If Next r Next c End Sub  

اليك الملف
البحث في القائمة بالحروف.xlsm

وعليكم السلام ورحمة الله وبركاته
 
هل تعنى انك لا تريد ظهور الواجهة  لاحتيار الملف وتريد الاستيراد مباشرة 
اليك الملف بدون ظهور الواجهة  ويكون الملفان في مكان واحد وبنفس الاسماء
اضغط على زر استيراد يتم احضار البيانات مباشرة
ملف.zip
 

السلام عليكم 
السبب هو وجود مسافات قبل الارقام وهذا يحدث عادة عند نسح ارقام ناتجة عن معادلات
 
الحل  كل القيم تتحول إلى نصوص (CStr) وتُزال الفراغات (Trim)  وهذا يضمن التطابق حتى لو كانت القيم أرقام أو نصوص أو ناتجة عن معادلات.
اليك الكود المعدل
Sub تحويل_اللجان_الى_اسماء_Turbo() Dim ws As Worksheet: Set ws = ActiveSheet Dim r As Long, c As Long Dim lastRowMain As Long, lastRowSearch As Long Dim رقم_اللجنة As String, اسم_اللجنة As String, اسم_المراقب As String Dim فارق_الاعمدة As Long: فارق_الاعمدة = 12 Dim cell As Range lastRowSearch = ws.Cells(ws.Rows.Count, "N").End(xlUp).Row ws.Range("P3:X" & lastRowSearch).ClearContents lastRowMain = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row lastRowSearch = ws.Cells(ws.Rows.Count, "N").End(xlUp).Row For r = 3 To lastRowMain اسم_المراقب = Trim(CStr(ws.Cells(r, "B").Value)) For c = 4 To 12 رقم_اللجنة = Trim(CStr(ws.Cells(r, c).Value)) If رقم_اللجنة <> "" Then For Each cell In ws.Range("C3:C" & lastRowMain) If Trim(CStr(cell.Value)) = رقم_اللجنة Then اسم_اللجنة = Trim(CStr(ws.Cells(cell.Row, "B").Value)) Dim صف_المراقب As Range For Each صف_المراقب In ws.Range("N3:N" & lastRowSearch) If Trim(CStr(صف_المراقب.Value)) = اسم_المراقب Then ws.Cells(صف_المراقب.Row, c + فارق_الاعمدة).Value = اسم_اللجنة Exit For End If Next صف_المراقب Exit For End If Next cell End If Next c Next r End Sub  

جرب التعديل التالي
test2.xlsm

وعليكم السلام ورحمة الله وبركاته
فكرة pdf انه يقوم بانشاء صفحة مؤقتة بها اسماء الموظفين وكل موظف قي ورقة ثم يصدرها الى pdf  قم يحذف الورقة
عدد الموظفين لديك حوالى 350 موظف 
بمعنى يتم انشاء حوالى 350 ورقة
المقصود مما سبق دكره ان الكود سيأحد بعض الوقت لتنفيذ الامر ويعتمد الامر على مواصفات الجهاز 
بالنسبة لجهازي تطلب الامر دقيقة ونصف بمواصفات في حدود الجيدة
اليك الملف
 
مرتب الفنيين عن شهر يناير 2026 تعديل.xlsm

السلام عليكم
تم التعديل ومسح البيانات للنطاق b7:h7 بعد الترحيل مع التسطير 
كذلك تم اظافة شرط وهو اذا كانت الخلايا في النطاق b7:h7 فارغة لا يتم الترحيل 
Employees5.xlsb

السلام عليكم
حسب قهمي للكود
الكود يتعامل مع العمود A والذي به ترقيم
والمفترض التعامل مع الاسماء في العمود B
اذا كان فهمي للامر صحيح اليك الكود المعدل والا قم بتوضيح الامر اكثر
تصوري Sub Compare2() Dim lr As Long, i As Long, j As Long Dim strCol As String Dim WS As Worksheet: Set WS = Worksheets("Data") Dim hasMissing As Boolean: hasMissing = False Application.ScreenUpdating = False On Error Resume Next lr = WS.Columns("B").Find(What:="*", SearchDirection:=xlPrevious).Row On Error GoTo 0 If lr < 6 Then Application.ScreenUpdating = True Exit Sub End If For i = 6 To 18 strCol = Split((WS.Columns(i).Address(, 0)), ":")(0) Dim lastInCol As Long lastInCol = WS.Cells(WS.Rows.Count, strCol).End(xlUp).Row If lastInCol < 6 Then lastInCol = 6 For j = 6 To lr If WorksheetFunction.CountIf(WS.Range(strCol & "6:" & strCol & lastInCol + 500), WS.Range("B" & j)) = 0 Then With WS.Cells(WS.Rows.Count, strCol).End(xlUp).Offset(1) .Value = WS.Range("B" & j).Value End With hasMissing = True lastInCol = lastInCol + 1 End If Next j Next i Application.ScreenUpdating = True End Sub   
 

وعليكم السلام ورحمة الله وبركاته
المشكلة الأساسية في الكود تكمن في طريقة التعامل مع تنسيق التاريخ. في VBA، عندما نستخدم SumIfs مع التواريخ، يفضل تمرير التاريخ كقيمة رقمية (Long)  اذا كانت الكميات ارقام صثحيحة و Double بدلاً من Long تحسباً لوجود كسور في الكميات (إذا كانت الكمية تحتوي على فواصل عشرية ) ، لأن تحويله إلى نص (String) مثل "MM/dd/yyyy" قد يتسبب في عدم تطابق البيانات إذا كان إعداد التاريخ في الجهاز مختلفاً.
جرب التعديل بالملف المرفق
SUMIFS_VBA.xlsm
 
 

السللام عليكم 
التغيير من السبنر المرتبط بالخلية 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