ياسر خليل أبو البراء

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

الأخ أبو حازم بعد إذن الأخ الحبيب سليم .بارك الله فيه إليك الحل التالي بدالة معرفة قمة في الروعة تغنيك عن كل هذا الكم من المعادلات ..حيث قام أخي وحبيبي سليم باخفاء ورقة العمل ورقة3 ووضع بها معادلات لاستخراج القيم الفريدة أما الدالة المعرفة فتغنيك عن كل هذا الأمر Function GetUnique(ArrDupes As Variant, Ref As Long) As Variant 'تقوم الدالة باستخراج القيم الغير مكررة وتخطي الخلايا الفارغة '=IFERROR(GetUnique($A$1:$A$20,ROW(A1)),"") '----------------------------------------------------------- Dim E With CreateObject("Scripting.Dictionary") If TypeOf ArrDupes Is Range Then For Each E In ArrDupes If E <> "" Then .Item(E.Value) = Empty Next Else For Each E In ArrDupes If E <> "" Then .Item(E) = Empty Next End If GetUnique = .keys()(Ref - 1) End With End Function تقبل تحياتي حصر الاسماء وفرزها YK.rar

أخي الكريم أبو عبد الملك أود المساعدة لكن الملف حاسس إنه غريب .. أقترح عليك استخدام الأكواد بحيث يكون حجم الملف أخف وأسرع في التعامل حيث لاحظت أن حجم الملف 1.8 رغم أن الملف لا يحتوي الكثير من البيانات في ورقة العمل المسماة "معلومات تسجيل الطلبة" يوجد أعمدة ليس لها مردود في ورقة العمل المسماة "سجل القيد" أي ليس لها وجود فيها فهل ستترك فارغة .. يرجى إعطاء بعض النتائج بشكل يدوي ولو نتيجة واحدة فقط ..

أخي في الله وحبيبي ومعلمي وأستاذي محمد صالح لكم يشرفني ويسعدني أن تكون أول من يرد على الموضوع جزيت خير الجزاء وبارك الله فيك تقبل تحياتي

الحمد لله الذي بنعمته تتم الصالحات مشكور أخي الكريم على تحديد أفضل إجابة ليظهر المنتدى بالشكل اللائق تقبل تحياتي

أهلا بكي أختي الفاضلة أليس في منتدى العجائب منتدى أوفيسنا مرحبا بك بين إخوانك يرجى تغيير اسم الظهور للغة العربية ويفضل طرح طلبك في موضوع مستقل مع إرفاق الملف الذي تودين العمل عليه

أخي الغالي محمد حسن أبو يوسف أحبك الله الذي أحببتنا فيه مشكور على تحديد أفضل إجابة .. وجزيت خيراً على كلامك الطيب الرقيق في حقنا تقبل تحياتي

الأخ الفاضل نهاية فوضوي إليك الكود التالي عله يفي بالغرض Sub RecordEmployee() Dim rngID As Range, WS As Worksheet, SH As Worksheet Dim LR As Long, X As Long Set WS = Sheets("in"): Set SH = Sheets("Sheet1") Set rngID = SH.Range("C5") With SH LR = .Cells(Rows.Count, "I").End(xlUp).Row + 1 If IsEmpty(.Range("C5")) Or IsEmpty(.Range("C7")) Or IsEmpty(.Range("C10")) Or IsEmpty(.Range("C13")) Then MsgBox "أكمل البيانات أولاً", vbExclamation: Exit Sub If Not WS.Range("A5:A" & WS.Cells(Rows.Count, 1).End(xlUp).Row).Find(rngID) Is Nothing Then X = Application.WorksheetFunction.Match(rngID, WS.Range("A5:A" & WS.Cells(Rows.Count, 1).End(xlUp).Row), 0) + 4 If Not .Columns("I:I").Find(WS.Cells(X, 2)) Is Nothing Then MsgBox "تم إدخال اسم الموظف " & WS.Cells(X, 2) & " من قبل", vbExclamation + vbMsgBoxRtlReading Else .Cells(LR, "I") = WS.Cells(X, 2) .Cells(LR, "J") = .Cells(7, "C") .Cells(LR, "K") = .Cells(13, "C") .Cells(LR, "L") = .Cells(10, "C") .Cells(LR, "N") = .Cells(16, "C") End If Else MsgBox "لا يوجد موظف لهذا الرقم", vbInformation: Exit Sub End If End With End Sub تم مراعاة ألا يتكرر اسم الموظف في الجدول 2 وألا تكون الخلايا التي سيتم التسجيل فيها فارغة ... جرب المرفق التالي وأعلمنا بالنتائج Record Employee Sales YasserKhalil.rar

إخواني الكرام تم إضافة كود رابع وتحدث الملف في الموضوع الأصلي .. عشان محدش يقوووووووول إني حارمكم من حاجة لا تنسونا من صالح دعائكم تقبلوا تحياتي

السلام عليكم ورحمة الله وبركاته إخواني الكرام في المنتدى الغالي أقدم لكم موضوع بسيط جداً ألا وهو كيفية إظهار المعادلات في الخلايا بدون أكواد سبق أن قدمت على الرابط التالي موضوع حول هذا الخصوص باستخدام دالة معرفة رابط الموضوع الآن بدون أكواد يمكن عمل ذلك بمنتهى اليسر والسهولة روح للتبويب Formulas ثم انقر على Name Manager ثم انقر New (وكفاية كدا نقر عشان منقلبش فراخ) اكتب اسم للنطاق الذي سيتم تسميته باسم ShowFormula ليكون معبر عن الهدف من المعادلة ، وفي الحقل المسمى Refers to اكتب المعادلة التالية =GET.CELL(6,INDIRECT("RC[-1]",FALSE)) وأخيراً أوك ... بس خلاص كدا الخطوة الكبيرة انتهت روح للخلايا اللي فيها المعادلات واكتب جنبها المعادلة التالية =ShowFormula هتظهر لك المعادلات المكتوبة في الخلايا في الملف المرفق تطبيق لما تم شرحه حمل الملف من هنا لا تنسونا بصالح دعائكم تقبلوا تحياتي

أخي الحبيب أبو يوسف الكود فقط يقوم بوضع قيمة في خلية Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.ScreenUpdating = False Range("P1").Value = Target.Address Application.ScreenUpdating = True End Sub يمكنك أن تغير الخلية لأي خلية أخرى بعيداً عن مجال البيانات أما بالنسبة لعملها بدون كود فأعتقد أن غير ممكن

أخي الكريم يرجى إرفاق ملف للعمل عليه

أخي الفاضل معين أكلمك بصراحة الملف غريب وحجمه أغرب على البيانات المدرجة فيه بعد ما فكيت الضغط لقيت الملف حجمه يعدي 48 ميجا (حجم عائلي) ولم أفهم الملف بشكل جيد أقترح عليك إعادة بناء الملف من جديد وتصميم ورقة الشهادات بحيث يكون فيها 3 أو 4 شهادات أو زي ما تحب وتستخدم دالة Vlookup دالة البحث أو حتى تستخدم أكواد ولكن يجب أن يكون الملف مصمم بشكل جيد يسهل التعامل معه تقبل تحياتي

الحمد لله أن تم المطلوب على خير أخي الحبيب أبو صلاح لا تنسى الالتزام بالتوجيهات (تحديد أفضل إجابة)

أخي الكريم أعتقد أن المعادلات لن تحل المشكلة حيث أن الموضوع الآن مرتبط بالتنسيق في الخلية من حيث Superscript إليك الملف التالي عله يفي بالغرض Transcripts.rar

أخي الكريم أبو يوسف راجع الرابط التالي عله يفيدك الرابط من هنا

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

أخي الكريم يرجى تغيير اسم الظهور للغة العربية جرب الكود التالي عله يفي بالغرض Sub CopySheetToAllSheets() Dim I As Long Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For I = 2 To 400 Sheet1.Cells.Copy Sheets(I).Paste Next I Application.CutCopyMode = False Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub تقبل تحياتي لا تنسى أن تحدد أفضل إجابة في حالة أن تم عمل المطلوب كما أردت

الأخ الفاضل أبو صلاح روح للتبويب Formulas ثم في نهاية التبويب هتلاقي Calculation Options اختار Automatic مش Manual أو لو مش عايز تغير الخيار ده (اضغط F9 من لوحة المفاتيح مع رغبتك في تحديث القيم)

عوداً حميداً أخي الحبيب مختار ونرجو لك مزيد من التوفيق والتميز لا حرمنا الله من روائعك تقبل تحياتي

الأخ الكريم أبو حبيبة وحنين إليك الفيديو التالي علك تجد فيه ضالتك

بارك الله فيك أخي الكريم أحمد النكلاوي وجزيت خيراً على دعائك الطيب مشكور على تحديد أفضل إجابة تقبل تحياتي

بارك الله فيك أخي الحبيب سليم وجزاك الله خير الجزاء في الدنيا والآخرة تسلم على هذا الكود الممتاز قمت بإضافة الكود للمشاركة الأولى لتحقيق أقصى استفادة من الموضوع وبهذا تم تحديث الموضوع ووضع حلول جديدة .. ثلاثة أكواد وحل بالمعادلات ليكون مرجع للباحث في هذا الخصوص فيما بعد .. بدلاً من تضييع الوقت في موضوعات مكررة تقبل تحياتي

أخي الغالي علي الشيخ أعتذر عن حذف المشاركات الغير ضرورية والتي تناولنا فيها حل مشكلة الـ AddIn وتمت إضافة المرفق الأخير في المشاركة الأولى حتى لا يتشتت الأعضاء الذين يقومون بالإطلاع على الموضوع بارك الله فيك وجزاك الله خير الجزاء في الدنيا والآخرة ولا حرمنا الله منك ولا من إبداعاتك المتميزة تقبل تحياتي

لطفاً أخي الكريم ارفق ملف قم بضغط الملف ثم ارفعه على سيرفر المنتدى كما يرجى تغيير اسم الظهور للغة العربية والإطلاع على رابط التوجيهات