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

أخي الكريم جمال يمكنك حذف الصفوف كلها من الملف مع الإبقاء على 100 صف فقط لتوضيح مسألتك (كنموذج للعمل عليه) - طبعاً بعيداً عن الملف الأصلي يعني خد نسخة من الملف والأصلي واحذف منها هذه الصفوف الكثيرة لتخفيف حجم الملف ..

=IF(DAY(A3)<DAY(B3),DAY(A3)+30-DAY(B3),DAY(A3)-DAY(B3)) أخي الحبيب أبو عيد جرب المعادلة التالية

أين الملف الأصلي ..المرفق الأصلي أخي الكريم؟

أخي الكريم سليم انظر لآخر رقمين في النتائج ليسا من ضمن الأرقام والمقابل لها صفر .. كما أن الأرقام ليست مرتبة في العمود G من المفترض أن الرقم 32 أكبر من 30 فله الأولوية في الترتيب .. أخي الحبيب أبو نصار نورت الموضوع وتشرفنا بتواجدك بمجرد ردك

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

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

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

أصلي عندي الحاسة السابعة ..فقريت أفكارك وكتبتها قبلك .. بس متقلقش سايبلك موضوعات كتيرة في المنتدى تشتغل فيها براحتك لأني مش خبير فيها (موضوعات الفورم تحديداً) تقبل وافر تقديري واحترامي

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

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

جرب التعديل التالي حيث أضفت سطر يعطل الحساب التلقائي إلى حين انتهاء عمل الكود ثم بعد انتهاء الكود يتم تفعيل الحساب التلقائي مرة أخرى .. جرب وأعلمني بالنتيجة Sub ConvertTextToNumber() Dim R As Range On Error Resume Next Application.ScreenUpdating = False Application.Calculation = xlManual For Each R In ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants) If IsNumeric(R) Then R.Value = Val(R.Value) Next R Application.Calculation = xlAutomatic Application.ScreenUpdating = True MsgBox "Done!", 64 End Sub تقبل تحياتي

Sub UniqueSortSpecial() Dim A As Variant, X As Variant, I As Long, J, N& Application.ScreenUpdating = False With Sheet1.Range("A2").CurrentRegion A = .Value With CreateObject("Scripting.Dictionary") .CompareMode = 1 For I = 1 To UBound(A, 1) For J = 1 To UBound(A, 2) If A(I, J) <> vbNullString Then If Not .Exists(A(I, J)) Then .Item(A(I, J)) = 1 Else .Item(A(I, J)) = .Item(A(I, J)) + 1 End If End If Next Next X = .Items: J = .Keys: N = .Count End With .Range("F1").Resize(N, 2) = Application.Transpose(Array(J, X)) With .Range("F2").CurrentRegion .Sort Key1:=.Cells(1, 2), Order1:=xlDescending, Key2:=.Cells(1, 1), Order2:=xlDescending, Header:=xlNo End With End With Application.ScreenUpdating = True End Sub أخي الحبيب الغالي سليم الكود لم يعطي نتائج صحيحة راجع الكود مرة أخرى .. ولي رجاء أن تقوم بتعريف المتغيرات وتضع الأكواد في موديول عادي وليس في موديول ورقة العمل ...أعتقد أن هذا أفضل أخي الكريم مشعل سلطان إليك الكود التالي عله يفي بالغرض Count Unique & Sort By Most Occurrences YasserKhalil.rar

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

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

جربت من قبل عدة برامج لكسر كلمات المرور على المصنف ولكن للأسف تستغرق وقت طويل ولا تفلح في حالة كانت كلمات السر معقدة

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

أخي الكريم أبو عبد الله ارفق الملف الذي به المشكلة لمحاولة عمل اللازم .. تقبل تحياتي

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

أخي الكريم طرازان هل اطلعت على هذا الموضوع http://www.officena.net/ib/index.php?showtopic=57813&hl=

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

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

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

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

أخي الكريم المراغي إليك الكود التالي ..جربته على ملفك ويعمل بشكل جيد جداً Sub ConvertTextToNumber() Dim R As Range, WS As Worksheet On Error Resume Next Application.ScreenUpdating = False For Each WS In ThisWorkbook.Sheets For Each R In Sheet1.UsedRange.SpecialCells(xlCellTypeConstants) If IsNumeric(R) Then R.Value = Val(R.Value) Next R Next WS Application.ScreenUpdating = True End Sub

أخي الغالي ابراهيم عدد صفوف ورقة العمل 1048576 مليون و48 ألف و576 بينما تتحدث عن عدد صفوف 2000000 أم أنك تقصد 200000؟