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

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

أخي الكريم أبو عبد الرحمن في ورقة البحث قم بوضع الكود التالي .. Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Range("J3:J" & Rows.Count)) Is Nothing Then Application.EnableEvents = False If IsError(Application.Match(Target.Value, Sheet1.Columns(1), 0)) Then Range("B3").Value = "" Else Range("B3").Value = Target.Value End If If IsError(Application.Match(Target.Value, Sheet2.Columns(1), 0)) Then Range("E3").Value = "" Else Range("E3").Value = Target.Value End If If IsError(Application.Match(Target.Value, Sheet3.Columns(1), 0)) Then Range("H3").Value = "" Else Range("H3").Value = Target.Value End If Application.EnableEvents = True End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim myVAL As String, LR As Long, NR As Long, ws As Worksheet If Target.Cells.Count > 1 Then Exit Sub If Target.Address = "$K$2" Then Application.EnableEvents = False Application.ScreenUpdating = False Range("J3:K" & Rows.Count).ClearContents NR = 3 myVAL = Target.Value For Each ws In Sheets(Array("الأسماء المرسلة", "أخطاء القاعدة", "أخطاء البطاقة")) With ws .AutoFilterMode = False .Rows(1).AutoFilter 2, "*" & myVAL & "*" LR = .Range("A" & .Rows.Count).End(xlUp).Row If LR > 1 Then .Range("A2:B" & LR).SpecialCells(xlVisible).Copy Range("J" & NR).PasteSpecial xlPasteValues NR = Range("J" & Rows.Count).End(xlUp).Row + 1 End If .AutoFilterMode = False End With Next ws Target.Activate Application.CutCopyMode = False Application.EnableEvents = True Application.ScreenUpdating = True End If End Sub أفضل أن تنسخ البيانات من ملفك إلى الملف الذي سأقوم بإرفاقه إن شاء الله لكي يعمل الكود بشكل صحيح .. بعدها قم بتنسيق المصنف كما يحلو لك ، وأعتذر عن أنني اقوم بالتنسيق بأسلوبي فهذا يريحني ويجعلني أستطيع التعامل مع الملف بشكل أوضح وإليك الملف المرفق تقبل تحياتي Search Process In Specific Multiple Sheets For Specific String YasserKhalil.rar

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

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

أخي الكريم مراد يرجى تغيير اسم الظهور للغة العربية إليك الكود التالي ..قف في أي خلية في الجدول الذي يحتوي البيانات ثم نفذ الكود Sub FilterDeleteRows() Dim rTable As Range Dim rCol As Range, rCell As Range Dim lCol As Long, iRow As Long Dim xlCalc As XlCalculation Dim vCriteria On Error Resume Next With Selection If .Cells.Count > 1 Then Set rTable = Selection Else Set rTable = .CurrentRegion End If End With On Error GoTo 0 If rTable Is Nothing Or rTable.Cells.Count = 1 Or WorksheetFunction.CountA(rTable) < 2 Then MsgBox "Could Not Determine Your Table Range.", vbCritical, "Exit Sub" Exit Sub End If ''''''''''''''''''''''''''''''''''''''''''''' 'الشرط vCriteria = "False" 'رقم أول صف للبيانات iRow = 6 'رقم العمود المراد فلترته lCol = 19 ''''''''''''''''''''''''''''''''''''''''''''' If lCol = 0 Then Exit Sub Set rCol = rTable.Columns(lCol) Set rCell = rCol.Cells(iRow, 1) With Application .Calculation = xlCalculationManual: .EnableEvents = False: .ScreenUpdating = False End With For lCol = 1 To WorksheetFunction.CountIf(rCol, vCriteria) Set rCell = rCol.Find(What:=vCriteria, After:=rCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Offset(-1, 0) rCell.Offset(1, 0).EntireRow.Delete Next lCol With Application .Calculation = xlCalculationAutomatic: .EnableEvents = True: .ScreenUpdating = True End With End Sub تقبل تحياتي

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

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

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

أخي الحبيب الزباري الملف لا يتم تحميله ..يرجى إعادة رفع الملف مرة أخرى تقبل وافر تقديري واحترامي

أخي الكريم أبو مجاهد هل تريد حساب المتوسط للنسب المئوية؟ يمكنك استخدام الدالة Average لحساب المتوسط لمجموعة من القيم تقبل تحياتي

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

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

الأخ الكريم شريف أهلاً بك في المنتدى ونورت المنتدى يرجى تغيير اسم الظهور للغة العربية والإطلاع على التوجيهات في الموضوعات المثبتة في المنتدى بالنسبة لتحويل الأرقام من اللغة العربية للإنجليزية أو العكس هل جربت استخدام خاصية Left To Right Text Dirsection هل جربت ضبط الإعدادات الإقليمية من خلال لوحة التحكم في الويندوز؟ احتمال آخر : حدد الخلايا التي بها الأرقام المراد تحويلها واعمل كليك يمين ثم Format Cells وشوف تنسيق الخلايا وجرب تخليها General

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

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

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

وجزيت خيراً بمثل ما دعوت لي أخي الحبيب وزيادة والحمد لله أن تم المطلوب على خير تقبل تحياتي

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

صراحة يعصب التخمين في مثل حالتك لأنني لا أدري شكل البيانات .. وأول مرة أرى أن أحد ما يحتاج لهذا الكم الهائل .. إنت شغال شغل محافظة بالكامل !!؟؟؟

إن شاء الله إذا تيسر لي الوقت سأحاول العمل على الطريقة إذا كانت الأرقام متتالية .. أعتذر الآن لضيق وقتي

وعليكم السلام الأخت الفاضلة رشا عماد مشكور على الاستجابة لتغيير اسم الظهور للغة العربية بالنسبة لطلبك ما زال هناك غموض أو يمكن القول أن المثال المرفق مرهق في متباعة النتائج عند التجربة أرجو إرفاق ملف آخر مشابه ولكن استبدلي البياناات ببيانات عادية بسيطة بدلاً من أسماء الأدوية الطويلة جداً .. يكتفى بعشرة صفوف فقط للتوضيح وضرب مثال لكي تكون الصورة أوضح على سبيل المثال : مجرد سؤال : البيان في الخلية B3 والخلية H3 هل هما نفس البيان ؟ لأن هناك اختلاف بينهما .. ولاحظي أن أي اختلاف بين البيانات ولو حرف سيؤدي إلى نتائج مختلفة فالبيان الاول : 5HT3ONDANSETRON INJECTION 2MG/ML 24ML AMPULE مختلف عن البيان 5HT3-ONDANSETRON INJECTION 2MG/ML 2-4ML AMPULE فهل هذا صحيح أم أنهما نفس البيان .. ولو كانا نفس البيان لديك فإنه ليس نفس البيان لدى الإكسيل ..نحن نتعامل مع آلة والحرف يفرق كتير لاحظي الاختلاف في الشرطة - أدى إلى الاختلاف بينهما الأفضل إرفاق ملف آخر أبسط وإن شاء الله تجدين الحل والمساعدة ..فقط تكون الأمور أوضح حتى يكون الحل بشكل سريع ومضمون عموماً كحل مبدئي قمت في ورقة العمل الأولى التي فيها الجدولين بتلوين الصفوف في الجدول الثاني التي لها مقابل في الجدول الأول باللون الأخضر تقبلي تحياتي Sample.rar

بعد إذن الأخ الغالي أبو عيد وإثراءً للموضوع إليك أخي الكريم أحمد عياد الكود التالي باستخدام المصفوفات وهي اسرع في التنفيذ من الحلقات التكرارية بمراحل إليك الكود التالي يوضع في موديول عادي Sub TransferUsingArrays() Dim a, aOutput, iCol As Long, iRow As Long, iLooper As Long With Worksheets("Sheet1") a = .Range("A1").CurrentRegion End With ReDim aOutput(1 To UBound(a) * UBound(a, 2), 1 To 12) For iCol = 2 To UBound(a, 2) For iRow = 2 To UBound(a) If a(iRow, iCol) > 0 Then iLooper = iLooper + 1 aOutput(iLooper, 1) = iCol - 1 aOutput(iLooper, 3) = a(1, iCol) aOutput(iLooper, 9) = a(iRow, 1) aOutput(iLooper, 12) = a(iRow, iCol) End If Next iRow Next iCol Sheet2.Cells(2, "A").Resize(iLooper, 12) = aOutput End Sub اضغط من لوحة المفاتيح Alt + F8 هيظهر لك نافذة الماكروهات الموجودة لديك اختر الماكرو المسمى TransferUsingArrays وانقر على Run ولاحظ سرعة التنفيذ .. يمكنك التأكد من سرعة الأداء بتنفيذ الكود على بيانات أكثر وليكن 20000 صف على سبيل المثال لتتأكد من سرعة أداء الكود باستخدام المصفوفات تقبل تحياتي Transfer Data YasserKhalil.rar

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

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

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