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

نعم بهذه الاظافة بمكن فهم طلبك الاستاذ محمد هشام اجاب عن طلبك بالمعادلات جزاه الله كل خير وان كنت تفضل الاكواد فاليك المرفق الملف احصاء عدد الطلبيات.xls ملاحظة اذا كان اصدار الاكسل عندك 2003 يجب التأكد من إضافة مرجع إلى مكتبة تشغيل نصوص Windows (Windows Script Host Object Model). يمكنك القيام بذلك من خلال الذهاب إلى Tools > References في محرر VBA وتحديد "Windows Script Host Object Model

السلام عليكم بعد اذن استالذنا أبومروان حل بواسطة المصقوفات الكود Sub ذكرين_انثيين() Dim ws As Worksheet Dim lastRow As Long Dim dataArray As Variant Dim males() As Variant Dim females() As Variant Dim resultArray() As Variant Dim maleCount As Long, femaleCount As Long Dim rowIndex As Long, i As Long, j As Long Set ws = ThisWorkbook.Sheets("ورقة1") lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row dataArray = ws.Range("A2:F" & lastRow).Value ReDim males(1 To UBound(dataArray, 1), 1 To UBound(dataArray, 2)) ReDim females(1 To UBound(dataArray, 1), 1 To UBound(dataArray, 2)) maleCount = 0 femaleCount = 0 For i = 1 To UBound(dataArray, 1) If dataArray(i, 6) = "ذكر" Then maleCount = maleCount + 1 For j = 1 To UBound(dataArray, 2) males(maleCount, j) = dataArray(i, j) Next j ElseIf dataArray(i, 6) = "انثى" Then femaleCount = femaleCount + 1 For j = 1 To UBound(dataArray, 2) females(femaleCount, j) = dataArray(i, j) Next j End If Next i ReDim resultArray(1 To maleCount + femaleCount, 1 To UBound(dataArray, 2)) rowIndex = 1 i = 1 j = 1 Do While i <= maleCount Or j <= femaleCount For k = 1 To 2 If i <= maleCount Then For col = 1 To UBound(dataArray, 2) resultArray(rowIndex, col) = males(i, col) Next col rowIndex = rowIndex + 1 i = i + 1 End If Next k For k = 1 To 2 If j <= femaleCount Then For col = 1 To UBound(dataArray, 2) resultArray(rowIndex, col) = females(j, col) Next col rowIndex = rowIndex + 1 j = j + 1 End If Next k Loop For i = 1 To UBound(resultArray, 1) resultArray(i, 1) = i ' الترقيم يبدأ من 1 Next i ws.Range("A2:F" & lastRow).ClearContents ws.Range("A2").Resize(UBound(resultArray, 1), UBound(resultArray, 2)).Value = resultArray MsgBox "تم الترتيب بنجاح !", vbInformation End Sub الملف فرز حسب الجنس بشروط.xlsb

السلام عليكم هل فتح الملف الثاني لم تخبرنى بالنتيجة يمكنك نسخ الكود ووضعه في حدث الورقة كلما كتبت رقما في العمود E يقوم بمسحه من العمود A ويتم نقل البيانات الى اعلى في العمود A لكي لا يبقى فراغ انتظر ردك

لا اعلم ما السبب حملت الملف ويعمل سارقع الملف مرة اخرى اخبرني بالنتيجة ازالة1.xlsm

وعليكم السلام ورحمة الله وبركاته في نفس الصفحة في العمود E بمكن تغييره من الكود الكود Private Sub Worksheet_Change(ByVal Target As Range) Dim cell As Range Dim foundCell As Range Dim ws As Worksheet Dim rng As Range Dim lastRow As Long Dim deleteRow As Long Set ws = Me Set rng = ws.Range("A:A") If Not Intersect(Target, Me.Range("E:E")) Is Nothing Then Application.EnableEvents = False For Each cell In Intersect(Target, Me.Range("E:E")) If cell.Value <> "" Then Set foundCell = rng.Find(What:=cell.Value, LookIn:=xlValues, LookAt:=xlWhole) If Not foundCell Is Nothing Then deleteRow = foundCell.Row foundCell.Delete xlShiftUp Else MsgBox "رقم العميل " & cell.Value & " غير موجود في قائمةالعملاء .", vbExclamation, "رقم غير موجود" End If End If Next cell lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row Set rng = ws.Range("A2:A" & lastRow) rng.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo Application.EnableEvents = True End If End Sub الملف officena.xlsb

السلام عليكم بالنسبة لي لم تصلنى فكرة طلبك بعد في جدول التحليل مثلا اليوم الاول نوجد خانة Driver ID من يكون وهم كثر ارجو ملء اسطر من جدول التحليل حنى تصل الفكرة بوضوح تحباني

وعليكم السلام ورحمة الله وبركاته الاكسل يمكنه التعامل مع الأرقام التي تصل إلى 15 رقمًا وسيحول الأرقام المتبقية إلى أصفار عن طريق كود يمكن عمل طلبك بشرط تحويل النطاق المراد الكتابة فيه الى نص شاهد المرفق ويمكنك تعديل النطاق من الكود format cell.xlsb

السلام عليكم الملف حجمه يتجاوز 11 مبقا بسبب التنسيق الشرطى للصفوف التسعة للعمود g من بداية العمود الى اخر العمود يعنى 9مليون خلية بها تنسيق شرطى ارجو تحديد المطلوب للملف كما اخبرك استاذنا الفاضل حسونة حسبن ساساهم بخاصية البحث عن طالب واظافة حالة الطالب من السداد وعدم السداد واحضار اجمالى الرسوم الى صفحة main وان هناك شئ نريد تعديله في الملف ارجو تحديده ملف المدرسة كامل الفصول 2024-2023.zip

وان اردتها بالمعادلات =IFERROR( INDEX(المعلومات!C$3:L$6;MATCH(C2;المعلومات!A$3:A$6;1);MATCH(D2;المعلومات!C$2:L$2;0)); "غير متوفر" ) 1ضريبة.xlsb

السلام عليكم الكود Sub CalculateTax() Dim wsInfo As Worksheet Dim wsEmployees As Worksheet Dim lastRow As Long Dim i As Long Dim j As Integer Dim salary As Double Dim status As String Dim tax As Double Dim minSalary As Double Dim maxSalary As Double Dim found As Boolean Set wsInfo = ThisWorkbook.Sheets("المعلومات") Set wsEmployees = ThisWorkbook.Sheets("الموظفين") lastRow = wsEmployees.Cells(wsEmployees.Rows.Count, 2).End(xlUp).Row For i = 2 To lastRow salary = wsEmployees.Cells(i, 3).Value status = wsEmployees.Cells(i, 4).Value found = False For j = 3 To 6 minSalary = wsInfo.Cells(j, 1).Value maxSalary = wsInfo.Cells(j, 2).Value If salary >= minSalary And salary <= maxSalary Then For Each cell In wsInfo.Range("C2:L2") If cell.Value = status Then tax = wsInfo.Cells(j, cell.Column).Value wsEmployees.Cells(i, 5).Value = tax found = True Exit For End If Next cell If found Then Exit For End If Next j If Not found Then wsEmployees.Cells(i, 5).Value = "" End If Next i MsgBox "تم حساب الضريبة بنجاح!", vbInformation End Sub الملف ضريبة.xlsb

السيد Khorsheed Omar المعادلة =IF([@[الاسم الثلاثي]]<>""; VLOOKUP([@[الاسم الثلاثي]]; 'البيانات الأساسية'!$A$2:$R$100;MATCH("2.2025"; 'البيانات الأساسية'!$1:$1; 0); FALSE); "") 1رواتب.xlsm

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

وعليكم السلام ورحمة الله وبركاته كود ترحيل التغيير من الوصل الى السجل.xlsm

جملتك هذه فهمت منها من كلمة نفس الحقول اي اتركها كما هي نتائج المقارنة.xlsb نتائج المقارنة1.xlsb

مرحبا اختنا الفاضلة لا تنس اضافة عمود العنوان الوظيقى للملفين بعد اسم الموظف قبل استخدام الكود ملف لجميع الحالات زبادة -نقص- نقس -حذف نتائج المقارنة.xlsb ملف لحالات الزيادة والنقص والحذف نتائج المقارنة.xlsb نتائج المقارنة1.xlsb

لم انتبه لذلك فعذرا شكرا لدعائك واطرائك الملف بحث بجزء من الإسم (1).xlsb

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

السلام عليكم لا مشكلة في الكود قمت بنجربة الكود على النص العربي يملفك والكود شغال 100% الكود يتعامل مع الحروف الإنجليزية والعربية، لأن دالة Split وخصائص Characters وFont.ColorIndex تعمل مع جميع النصوص، بغض النظر عن اللغة الدالة Len تعمل مع جميع النصوص بغض النظر عن اللغة، سواء كانت النصوص مكتوبة باللغة العربية، الإنجليزية، أو أي لغة أخرى. فهي ببساطة تُرجع عدد الأحرف في النص، ولا تهتم بنوع الأحرف أو اللغة المستخدمة. وطريقة عمل التلوين حيت تقوم بتحديد النص المراد تلوبن احد حروفه او اكثر من حرف ثم تكتب الحرق في الصندوق inputbox قيتم تلوبن النص بالتوفيق

اضافة للكود استدعاء اسم المادة ورمز المادة الافادة.xlsm

وعليكم السلام ورحمة الله تعالى وبركاته اظافة الى ما تقضلو به اساتذتنا الاكارم TEST CODE1.xlsm

وعليكم السلام ورحمة الله وبركاته حسب المعادلة في ملفك يمكن استبدالها بمعادلة اخرى لها نفس المهام =SUMPRODUCT(C4:AA4; C$3:AA$3) طبعا لا يمكن لصقها مكان معادلة الصفيف الا بطريقة تظلبل معادلات الصفيف في العمود بالكامل ثم مسح البيانات تم لصق المعادلة الملف المصنف1.xlsx

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

السلام عليكم جربت الكود أحمد -إبراهيم -إسلام -آية- أيمن - الادارية-الإدارية - ادارة سميرة -شئ - وغيرهاكلها يالهمز وبدون همز شغال 100% الكود بقوم بالتغاضى عن : جمبع حروف الالف لاي كلمة بالقتح او بالكسر يتم البحث عنها سواء كتبتها بالهمز او بدونه جمبع حروف الياء لاي كلمة عند البحث لو كتبنها الف مقصورة ى يتم احضار قيمتها كذلك كلمة شئ مثلا او ما في حكمها عند البحث لو كتبنها شى بدون همزة يتم احضار قيمتها كذلك اي كلمة فيها ة عند البحث لوكتبتها ه يتم احضار قيمتها وسواء كان الحروف السابقة كانت في اي موقع من الكلمة في بداية او وسط او نهاية الكلمة يقوم باحضار قيمتها كذلك اذا كانت الكلمة حروفها لا تتكرر مع كلمة اخرى مثلا كلمة إبراهيم لو كتبت في البحث هيم يحضر قيمتها كذلك الكود مرن يمكن اظافة اي حروف للكود تريد اهمالها عند البحث str = Replace(str, "أ", "ا") str = Replace(str, "إ", "ا") str = Replace(str, "آ", "ا") str = Replace(str, "ي", "ى") str = Replace(str, "ئ", "ي") str = Replace(str, "ة", "ه") ارفق لك الملف مرة اخرى ولم اغير شيئا بالكود اصدار الاوفيس لدي 2016 وحسب علمى الكود متوافق مع كل الاصدرات بحث حتى لو فى اخلاتف بسيط1.xls

استبدل هذا الجزء في كود الاستاذ محمد هشام بهذا OnRng(n, tmp + 1) = OnRng(n, tmp + 1) + g(i, 1) الملف ( اذا تحقق طلبك بهذا الملف فصاحب الكود يستحق افضل اجابة وهو استاذنا محمد هشام) KNTPROD V1.xlsb

السلام عليكم حسب فهمى لطلبك انك تكتب في الخلية A1 يبقى الكود ثانية ثم ينتقل الى الخلايا التي بعدها في نفس العمود والفارق الزمني ثانيةواحدة بين نقلة واخري الكود ينتقل الى اخر خلية فيها بيانات ثم يتوقف يمكن تعديل الزمن في الكود الى اي مدة Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Not Intersect(Target, Me.Range("A1")) Is Nothing Then If Target.Value <> "" Then Application.OnTime Now + TimeValue("00:00:01"), "MoveToNextCellContinuously" End If End If End Sub Sub MoveToNextCellContinuously() Static NextCell As Range On Error Resume Next If NextCell Is Nothing Then Set NextCell = Worksheets("Sheet1").Range("A2") Else Set NextCell = NextCell.Offset(1, 0) End If If NextCell.Row <= Worksheets("Sheet1").Rows.Count And NextCell.Value <> "" Then NextCell.Select Application.OnTime Now + TimeValue("00:00:01"), "MoveToNextCellContinuously" End If End Sub الملف 011.xlsm