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

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

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

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

أخي الكريم سعد عابد مشكور على مرورك الكريم بالموضوع وجزاك الله خيراً وعليكم السلام أخي الحبيب أبو يوسف بارك الله فيك وجزيت خيراً على مرورك العطر بالموضوع ، والمميز هو مرروك أخي الغالي

أخي الكريم ارفق ملف ليتمكن الأخوة من تقديم المساعدة المطلوبة إن شاء الله

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

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

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

أخي الكريم عبد الله جرب الكود التالي Public Sub FindNames() Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet, Report As Worksheet Dim FindRange As Range, SearchRange1 As Range, SearchRange2 As Range Dim R As Long, LastRow1 As Long, LastRow2 As Long, LastRowReport As Long Dim X Set Sh1 = ThisWorkbook.Worksheets("a") Set Sh2 = ThisWorkbook.Worksheets("n") Set Report = ThisWorkbook.Sheets("الجدول الرئيسي") LastRow1 = Sh1.Cells(Sh1.Rows.Count, 1).End(xlUp).Row LastRow2 = Sh2.Cells(Sh2.Rows.Count, 1).End(xlUp).Row LastRowReport = Report.Cells(22, 1).End(xlUp).Row Set SearchRange1 = Sh1.Range(Sh1.Cells(2, 1), Sh1.Cells(LastRow1, 1)) Set SearchRange2 = Sh2.Range(Sh2.Cells(2, 1), Sh2.Cells(LastRow2, 1)) X = InputBox("Enter The Item To Search", "Search Box") On Error Resume Next Set FindRange = SearchRange1.Find(What:=X) If Not FindRange Is Nothing Then Set FindRange = CheckForMore(FindRange, SearchRange1) Report.Cells(LastRowReport + 1, 1).Value = Sh1.Cells(FindRange.Rows.Row, 1).Value End If Set FindRange = SearchRange2.Find(What:=X) If Not FindRange Is Nothing Then Set FindRange = CheckForMore(FindRange, SearchRange2) Report.Cells(LastRowReport + 1, 2).Value = Sh2.Cells(FindRange.Rows.Row, 1).Value End If End Sub Public Function CheckForMore(Arg As Range, SearchRange As Range) As Range Dim FindRange As Range Dim Count As Long Set FindRange = Arg Do Set FindRange = SearchRange.Find(What:=Arg.Value, After:=FindRange(1)) Debug.Print Arg.Address, FindRange.Address Count = Count + 1 Loop Until FindRange.Address = Arg.Address If Count > 1 Then MsgBox "There Is More Than One " & Arg.Value & "!" & vbCrLf & "Only The First One Has Been Done." Set CheckForMore = FindRange End Function تم وضع معادلات في العمود الثالث .. أرجو أن يكون المطلوب .. تقبل تحياتي فرز الارقام.rar

بارك الله فيك أخي العزيز محي الدين وجزيت خيراً الأروع هو مرورك أخي الحبيب ياسر البنا .. عفواً لم أنتبه لردودكم إلا الآن ..

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

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

أخي العزيز حسين نورت المنتدى بمشاركتك الجميلة .. وعوداً حميداُ .. لا تحرمنا من تواجدك بيننا ومعنا تقبل تحيات أخوك أبو البراء

الأخت الفاضلة رشا .. يحبذ دائماً طرح أي طلبات جديدة في موضوع مستقل .. عموماً إليكي الكود التالي عله يفي بالغرض .. يقوم الكود بنسخ الجدول الأساسي ثم استخراج القيم التي في كلا الجدولين (الجدول الأول والثاني) .. الكود بسيط جداً ويمكن فهمه بسهولة Sub Test() Dim Sh As Worksheet: Set Sh = Sheets("Sheet1") Dim Lr As Long: Lr = Sh.Cells(Rows.Count, 1).End(xlUp).Row Application.ScreenUpdating = False With Sh .Columns("N").Resize(, 5).Clear .Range("A2:C" & Lr).Copy .Range("N2") .Range("Q2:R2").Value = Array("Total Issued1", "Total Issued2") .Columns("P").Copy: .Columns("Q:R").PasteSpecial Paste:=xlPasteFormats .Columns("N").Resize(, 5).AutoFit With .Range("Q3:Q" & Lr) .Formula = "=IFERROR(INDEX(G:G,MATCH(O3,F:F,0)),"""")" .Value = .Value End With With .Range("R3:R" & Lr) .Formula = "=IFERROR(INDEX(K:K,MATCH(O3,J:J,0)),"""")" .Value = .Value End With End With Application.CutCopyMode = False Application.ScreenUpdating = True End Sub أرجو أن يكون المطلوب ويفي بالغرض .. Compare Two Tables With Main Table YasserKhalil.rar

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

عوداً حميداً أخي الحبيب الغالي ياسر فتحي ..المنتدى نور بطلعتك البهية

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

أخي الكريم محمود شيل الرقم 5 وضع مكانه النطاق Range("A4").Value ..إذا لم يكن المطلوب فيرجى إرفاق ملف

أخي الكريم يرجى رفع الملفات على سيرفر المنتدى إلا إذا تعذر الأمر الموضوع يحتاج لتوضيح ..ما هو الملف المراد العمل عليه (فيه مصنفين) ..أي أوراق العمل ستعمل عليها .. ما هو شكل النتائج المتوقعة ... إلى آخر تلك التفاصيل ..!

أخي الكريم صلاح ارفق البرنامج الذي ذكرته Excel Password Recovery لنحاول إيجاد كراك له ..بس السؤال قبل الكراك هل البرنامج فعال أم أنك تريد التجربه ؟ ومثله مثل غيره ..يتعامل بنظرية الاحتمالات ..@@@

أخي الحبيب أبو يوسف نعم باستخدام خاصية ScreenUpdating قبل التنفيذ تلغي التحديث وبعدها يمكنك تفعيله .. وعلى فكرة حتى لو لم تضف سطر لإعادة التحديث لا يؤثر في شيء حيث تعود الأمور إلى طبيعتها بعد انتهاء عمل الكود أي يمكن فقط استخدام سطر واحد لالغاء التحديث ، ولكن من الباب الجمالي توضع في البداية والنهاية بالنسبة للنطاق الديناميكي الموضوع في غاية السهولة .. فقط اتبع نصيحتي وأنت تعرف كيفية عمل ذلك: النطاق المستخدم هو A1:B10 المطلوب : استبدال الرقم 10 ليصبح رقم آخر صف به بيانات في العمود الأول (اللي هو أساس الشغل بتاعنا في المثال) استخدم الجملة دي مكان رقم 10 Cells(Rows.Count, "A").End(xlUp).Row يبقى المطلوب تعمله تشيل رقم 10 وبس ..لا تمس التنصيص الموجود .. ولا تمس قوس الإغلاق وبعد علامة التنصيص وقبل قوس الإغلاق تضع مسافة بالمسطر ثم علامة & اللي بتيجي من خلال الضغط على Alt + 7 ثم مسافة ... ثم تضع الجملة السحرية اللي أشرت إليها وبس خلاص جرب الكود بإضافة بيانات جديدة للتأكد من فعالية الإضافة .. وبكدا تقدر تتعامل مع النطاق بشكل ديناميكي الأخ الحبيب رمهان اللي يعمل خير ميشورش .. هات ما عندك .. أثري الموضوع بإبداعاتك الأخ الغالي الجموعي بارك الله فيك وجزاك الله خيراً على مرورك العطر بالموضوع وعلى الحل المقدم .. سأطلع عليه ولو فيه أي تعليق هبلغك بيه ... أنا بعمل عملية تشريح لكل كود وكل حل يقدم خلي بالك .. تقبلوا جميعاً تحياتي

دا طلب يا أخي الحبيب رمهان ولا فكرة ولا مشاركة هتشارك بيها أخي الحبيب أبو يوسف ننتظرك فيما بعد لتكمل الكود إن شاء الله

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

أخي الحبيب أبو يوسف الحمد لله أن تم المطلوب على خير .. هكذا أصبح الكود ناااااااااجح بنسبة 100% .. الله ينور عليك .. أيوا كدا ابدأ اشتغل وخلي الماكنة تطلع قماش .. وإليك حل بأسلوب آخر لنفس الكود Sub SortByLEN() With Range("A1:B10") .Offset(, 1).FormulaR1C1 = "=LEN(RC[-1])" .Sort Key1:=Range("B1"), Order1:=xlDescending, Header:=xlNo .Offset(, 1).ClearContents End With End Sub تقبل تحياتي

أخي الحبيب أبو يوسف ..يبدو أنه حدث لبس عندي بسبب النظر فلم يكن النطاق أي المدى المشترك واااااحد .. فكل سطر مختلف : السطر الأول والثالث متشابهان بينما الثاني مدى مختلف ..راجع النطاقات .. حيث أن المعادلة توضع في النطاق B1:B10 ويتم مسح المعادلات بعد الفرز B1:B10 بينما عملية الفرز نفسها تتم على النطاق A1:B10