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

وعليكم السلام ورحمة الله وبركاته استاذ خيرى / كيف حالك اتمنى ان تكون يخير محاولة لطلبك الافادة.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

https://excelnoob.com/vba-password-remover/

نفضل كود الطباعة سرى الشهادة الاعدادية (2).xlsb

اتصحك بتحميل لصدار حديث لاته هناك دوال لا تعمل على الاصدارات القديمة المشكلة في اصدار الاكسل لديك قمت يالتعدبل على الكود ليتوافق مع 2007 جرب الملف المعدل سرى الشهادة الاعدادية.xlsb

الملف يعمل بدون مشاكل من خلال الصورة المرفقة بلدو ان اصدار الاوفيس 2007 ان كان 2007 فالكود اعتقد لا يتوافق مع هذا الاصدار

السلام عليكم الاستاذ محمد هشام اهنئك على الكود الرائع اعتقد انه يقصد جمع الارقام في التاريخ المتشابه بمعنى OnRng(n, tmp + 1) = OnRng(n, tmp + 1) & "-" & g(i, 1) بدل الشرطة بربد جمعة OnRng(n, tmp + 1) = OnRng(n, tmp + 1) + g(i, 1) هذا حسب فهمى لطلبه والله اعلم وننتظر رأيه في الامر

,وعليكم السلام توجد نقطة مهمة وهي توجد تواريخ مكررة اين توضع كمياتها كما في مثالك

السلام عليكم ورحمة الله وبركاته تفضل واتمنى ان يحقق طلبك تم عمل قائمة اختيار (شاهد الصورة المرفقة) الكود Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Me.Range("N5")) Is Nothing Then Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim wsSource As Worksheet Dim wsDest As Worksheet Dim schoolName As String Dim lastRow As Long Dim destRow As Long Dim i As Long Set wsSource = ThisWorkbook.Sheets("اسماء العاملين ") Set wsDest = ThisWorkbook.Sheets("طباعة كشف المدرسة") schoolName = Me.Range("N5").Value wsDest.Range("A9:Z" & wsDest.Cells(Rows.Count, "A").End(xlUp).Row).ClearContents destRow = 9 lastRow = wsSource.Cells(Rows.Count, "B").End(xlUp).Row For i = 7 To lastRow If wsSource.Cells(i, 6).Value = schoolName Then wsDest.Cells(destRow, 1).Value = destRow - 8 wsDest.Cells(destRow, 2).Resize(, 4).Value = wsSource.Cells(i, 2).Resize(, 4).Value wsDest.Cells(destRow, 9).Value = wsSource.Cells(i, 6).Value destRow = destRow + 1 End If Next i Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End If End Sub الملف سرى الشهادة الاعدادية.xlsb سرى الشهادة الاعدادية.xlsb

وعليكم السلام ورحمة الله وبركاته المعادلة =SUMIFS(C:C; B:B; ">=" & DATE($E$4;1;1); B:B; "<=" & DATE($E$4;12;31)) الملف جمع القيم بناء على السنة.xlsx وفقكم الله

السلام عليكم ورحمة الله وبركاته عن طريق الكود ويمكن اضافة اي حرف احتمال يحدث فيه اختلاف شاهد المرفق بحث حتى لو فى اخلاتف بسيط1.xls وفقك الله

وعليكم السلام ورحمة الله وبركاته بدون ارفاق ملف ندخل في باب الاحتمالات اما .... واما الرسالة المعروضة تعني أن هناك عنصرًا (مثل ActiveX أو مكون في UserForm كـ ListBox أو ComboBox او غيره) في النموذج الخاص بك اوفي الاكواد غير متوفر على جهازك. بمكنك معرفة الكائن او المكتبة الغير متوفرة من خلال :- 1- الكود 2- او الانتقال إلى Developer > Visual Basic > Tools > References اذا وجدت كلمة MISSING (بمعنى مفقود) المكتوب امام الكلمة هي المكتبة المفقودة الصورة المرفقة كمثال لمكتبة مفقودة 3- الغاء التاشير من كلمة MISSING قد يحل المشكلة احيانا وليس دائما اتمنى ان اكون قدمت لك ما يقيد لك وافر التقدير والاحترام

السلام عليكم ورحمة الله وبركاته الملف به 1048576 مليون معادلة صفيف في صفحة الموظفين به 1048576 مليون معادلة صفيف في صفحة المعلمبن 8 تم حذف المعادلات ويمكنك اعادة كتابنها حسب حاجنك لم توضح ما هو الذي تريد البحث عنه وفي اي شبتات واين توضع نتيجة البحث على كل حال محاولة حسب تخمينى يوجد زر في شيت الرئيسية باسم بحث مدرسة ديوان الطالب مفصلة 26-10-2024.xlsb

لو طبقت ماطلبناه منك وهو كنابة النتائج يدويا لسهلت علينا الامر ,, اذاكان رامي يفترض ترقيمه 16 كما ذكرت معنى هذا هو اول خطأ في الترقيم وكل ماسبقه صحيح واخرهم ابو رامي وترقيمه 15 ولكن حسب من تنطبق عليه الشروط حسب فهمي يكون رامي ترقيمه 12 وليس 16 جرب المعادلة =IF(J2 > 110; IF(I2 <> ""; MAX(H$1:H1) + 1; MAX(H$1:H1)); "")

السلام عليكم ورحمة الله وبركاته جرب المعادلة =IF(AND(B2=0; A2>0); A2 + 1; IF(AND(B2>=1; A2=0); 0; IF(AND(B2>=1; A2>0); A2 - B2; A2))) الملف المصنف1.xlsx

اخونا الفاضل : السلام عليكم ورحمة الله وبركاته النتائج اليدوية : - المقصود بها ان تكتب في العمود G مثلا الترقيم الصحيح الذي تريده يدويا في الخلايا الملونة حتى بتضح لنا اين الخلل في الترقيم مع ترك العمود H كما هو ثانبا العمود i لاحظت انك تذكر اكبر من الصفر هل العمود تصي ام رقمي ننتظر توضبحكم مع وافر التقدير والاحترام

وعليكم السلام ورحمة الله وبركانه في الإصدارات الحالية من Excel، حسب علمى لا يوجد والله اعلم

وعليكم السلام ورحمة الله وبركاته لو ارفقت لنا ملفك لاختصرت الوقت او ارفقت الجملة التى بها خطأ لسهلت لنا الامر يدون ملف محاولات قد تصيب وقد تخطئ ريما السبب من جملة FILESEARCH والتي اعتقد انها غير متوافقة مع الاصدارات بعد 2003 ( غير متاكد منها) سنفترض ان الامر منها فيكون تعديل الكود كالتالى Private Sub FrstChnge(combo1 As ComboBox, combo2 As ComboBox) Dim val As String Dim Namey As String Dim fso As Object Dim folder As Object Dim file As Object combo2.Clear If combo1.Value = "" Then MsgBox "الرجاء اختيار شيت من القائمة", vbExclamation Exit Sub End If val = ThisWorkbook.Path & "\" & combo1.Value & "\Ser" Set fso = CreateObject("Scripting.FileSystemObject") If fso.FolderExists(val) Then Set folder = fso.GetFolder(val) For Each file In folder.Files If LCase(fso.GetExtensionName(file.Name)) = "xlsx" Then Namey = file.Name Namey = Left(Namey, Len(Namey) - 5) ' إزالة الامتداد .xlsx combo2.AddItem Namey End If Next file Else MsgBox "المجلد غير موجود: " & val, vbExclamation End If Set fso = Nothing Set folder = Nothing Set file = Nothing End Sub او جرب الكود التالى Private Sub FrstChnge(combo1 As ComboBox, combo2 As ComboBox) Dim val As String Dim filePath As String Dim fileName As String val = combo1.Value combo2.Clear If val = "" Then Exit Sub filePath = ThisWorkbook.Path & "\" & val & "\Ser\" fileName = Dir(filePath & "*.xls*") Do While fileName <> "" combo2.AddItem Left(fileName, Len(fileName) - 4) fileName = Dir Loop End Sub اذا لم بعمل ارفق ملفك وفقك الله

وعليكم السلام ورحمة الله وبركاته =CEILING(G14*E14; 1) بالتوفيق

وعليكم السلام ورحمة الله وبركاته تم عمل كود بدل معادلات الصفيف والترتيب الكود ينظر الى السنة اولا بمبن العلامة المائلة ثم يبحث عن اصغر رقم يسارا تم عمل قائمة اختيار لاختيار N° Bordereau وكلما اضفت رقما اضيف الى القائمة لك كل الاحترام والتقدير BORDEREAU FACILE1.xlsm

جربى الملف المرفق وفيه حالة نفس المرتب المعايير التى بنى عليها الكود هي :- المقارنة بين المرتبات: يقوم الكود بمقارنة المرتب الرسمي لكل موظف بين الملفين، ويضيف النتيجة إلى العمود H في ملف المقارنة: زيادة في المرتب: إذا كان المرتب في الملف الثاني أكبر من المرتب في الملف الأول. نقص في المرتب: إذا كان المرتب في الملف الثاني أقل من المرتب في الملف الأول. نفس المرتب: إذا كان المرتب في الملفين متساويًا. محذوف: إذا كان اسم الموظف موجود في الملف الأول ولكن غير موجود في الملف الثاني. جديد: إذا كان اسم الموظف موجود في الملف الثاني ولكن غير موجود في الملف الأول. نتائج المقارنة.xlsb وهذا الملف خاص بمن زادت او نقصت او حذفو او جددفقط بدون نفس المرتب نتائج المقارنة1.xlsb

ساقوم بالتعديل ان شاء الله

السلام عليكم ورحمة الله وبركانه صبحكم الله بالخير جرب الملف وان لم يكتمل حدد ما هو المطلوب لك وافر التقدير والاحترام نقل أعمدة محددة من ورقة الى أكثر من ورقة+222222.xlsm