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

أعتذر أخي عن التأخر في الرد إليك الملف التالي فيه التعديل .. الملف معتمد على الملف الذي قمت بإرفاقه من قبل .. حيث وجدت ملفك المرفق يحتاج لنفس الخطوات التي قمنا بها من قبل وفي هذا مشقة .. أرجو أن يفي بالغرض إن شاء الله Grab Data By Hijri Dates Using Arrays YasserKhalil V2.rar

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

هل حربت الملف الذي أرفقته؟ ما هي المشكلة التي صادفتك بالتحديد؟ عموماً جرب الملف التالي عله يكون المفيد لك Create VCF.rar

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

غريبة دي!! ولا حتى IFERROR أو متأكد أنت؟ قم بتنسيق الخلابا التي تظهر فيها الأصفار بهذا الشكل 0;-0;;@

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

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

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

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

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

أخي الكريم أبو عيد بارك الله فيك على قوة الملاحظة .. الكود يعتمد على استخراج القيم الغير مكررة .. لذا وجب استخدام كود آخر يؤدي نفس الغرض المطلوب كما وضحت جرب التالي Sub Test() Dim coll As New Collection, rng As Range, arr, c As Long, I As Long, strKey As String, v1 Set rng = Range("A1").CurrentRegion rng.Offset(1).Interior.ColorIndex = xlNone arr = rng.Value For I = 2 To UBound(arr, 1) strKey = Abs(arr(I, 3)) On Error Resume Next coll.Add Key:=strKey, Item:=Array(New Collection, New Collection) On Error GoTo 0 If Sgn(arr(I, 3)) = -1 Then coll(strKey)(0).Add I Else coll(strKey)(1).Add I Next I For Each v1 In coll I = Application.Min(v1(0).Count, v1(1).Count) If I > 0 Then c = RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256)) For I = 1 To I rng.Rows(v1(0)(I)).Interior.Color = c rng.Rows(v1(1)(I)).Interior.Color = c Next I End If Next v1 End Sub تقبل تحياتي

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

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

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

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

ممكن توضيح أكثر للمسألة .. لا ينبغي التحدث بشكل عام في أي مشكلة .. يجب تحديد الهدف حدد الهدف وسدد .. وإن شاء الله ييجي جوووووووووووووول

جرب الملف دا .. بس مش عارف كلمة المرور الآن بس لو حبيت أعرفها هعرفها ..ممكن تكون مذكورة في الموضوع الأصلي برنامج مخازن محمد حسن المحمد.rar

أخي الكريم جرب الكود التالي لتحصل على لون مختلف لكل زوج من الأرقام .. مثلاً 50 و -50 لهما نفس اللون يمكنك تنفيذ الكود أكثر من مرة لتغيير الألوان بشكل عشوائي .. أرجو أن يفي بالغرض إن شاء الله Sub Test() Dim r As Range, dic As Object, w, temp Set dic = CreateObject("Scripting.Dictionary") dic.CompareMode = 1 Application.ScreenUpdating = False With Range("C2:C" & Cells(Rows.Count, 1).End(xlUp).Row) .Offset(, -2).Resize(1, 9).Interior.ColorIndex = xlNone For Each r In .Cells If Not IsEmpty(r.Value) Then temp = Abs(r.Value) If Not dic.Exists(temp) Then ReDim w(1 To 3) Set w(1) = r With Application.WorksheetFunction w(2) = Array(.RandBetween(0, 255), .RandBetween(0, 255), .RandBetween(0, 255)) End With w(3) = r.Value dic(temp) = w Else w = dic(temp) If r.Value + w(3) = 0 Then r.Offset(, -2).Resize(1, 9).Interior.Color = RGB(w(2)(0), w(2)(1), w(2)(2)) If Not IsEmpty(dic(temp)(1)) Then dic(temp)(1).Offset(, -2).Resize(1, 9).Interior.Color = RGB(w(2)(0), w(2)(1), w(2)(2)) dic.Remove temp End If End If End If Next r End With Application.ScreenUpdating = True End Sub تقبل تحياتي

أعتقد أن المطلوب صعب بالتنسيق الشرطي ..هل من الممكن أن نحاول بالأكواد أم أنك مصر على التنسيق الشرطي؟

إن شاء الله ليلاً سأحاول العمل عليه إذا لم يتدخل أحد الأخوة تقبل تحياتي

وعليكم السلام أخي الكريم حسب ما فهمت من طلب جرب الكود التالي ..أدخل بعض الأرقام في الأعمدة C و D و E في ورقة العمل "ادخال البينات" وجرب الكود مرة ولاحظ النتائج في ورقة العمل "تجميع البيانات" ثم جرب الكود مرة أخرى ولاحظ النتائج ، ثم جرب الكود مرة أخرى ولاحظ النتائج (لاحظ إن ايدي تعبت من التكرار) إليك الكود ..يوضع في موديول عادي للذهاب لمحرر الأكواد اضغط Alt + F11 ومن قائمة Insert اختر Module ثم الصق الكود ... لتنفيذ الكود اذهب لورقة العمل "تحميع البيانات" مثلاً واضغط Alt + F8 واختر الإجراء المسمى Sum_Matching_Data ثم أخيراً انقر Run لتنفيذ الكود رابط الكود من هنا تقبل تحياتي

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

أضف شرط للكود في هذا السطر لتحصل على المراد If Month(DHijri(CDate(Arr(I, 5)))) = lMonth And Year(DHijri(CDate(Arr(I, 5)))) = lYear Then ستضيف كلمة And قبل كلمة Then وتضيف الشرط .. ولكن يجب أن تكون هناك خلية تحتوي على المؤسسة والوقف للاعتما عليها ارفع الملف بدون كود تماماً كما أرفقته لك مع وضع خلية بها المعطيات ..

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

وعليكم السلام جرب الكود التالي Sub Test() Dim myFile As String myFile = ThisWorkbook.Path & "\" & Range("C4").Text & "-" & Range("C6").Text & ".pdf" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myFile MsgBox "Done...", 64 End Sub