اظهار المبالغ السليمة وعكسها من خلال التنسيق الشرطي او طرق اخرى

[ابو وسام محمد]

السلام عليكم ورحمة الله وبركاته

اخواني في منتدى الاكسل

ارجوا مساعدتي 

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

مع العلم وجود مبالغ مكررة لكن انا احتاج فقط المبلغ وعكسه حسب البيانات في الاعمدة بالضبط .

 

ولكم تحياتي

test.rar

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

وعليكم السلام أخي الكريم

يرجى تغيير اسم الظهور للغة العربية

 

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

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

أرجو تفهم الأمر لأنني اطلعت على الملف ولم أفهم المطلوب ..

[ابو وسام محمد]

اعتذر لكم جميعا 

عن عدم توضيح للمطلوب في المرفق

والان تم ارفق شرح للمطلوب

test.rar

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

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

 

[ابو وسام محمد]

اخوي ياسر

اشكرك على تجاوبك السريع

انا يهمني في الموضوع اظهار المبلغ وعكسه فقط لكي اقوم بحذفة كليا من القائمة

اما الطريقة فمتروك لك حرية الاختيار

[سليم حاصبيا]

ربما يكون هذا المطلوب

special_formt salim.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

تقبل تحياتي

[أبوعيد]

ماشاء الله , كود لطيف وجميل

أستاذ ياسر قمت بعمل تجربة على كودك الجميل 

وتبين أن هناك أسطرا لم يلونها مثل 40 و 54  وكذلك 41 و 55

 

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

أخي الكريم أبو عيد

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

جرب التالي

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

تقبل تحياتي

 

[أبوعيد]

الأن مضبوط 100%

[ابو وسام محمد]

اخواني الاعزاء

بارك الله لكم في مجهودكم وانار الله قلوبكم بالتقوى وحب عمل الخير

حل جميل 

لكن لم يغي بالمطلوب تماما

مرفق لكم ملف منفصل بشرح المطلوب

اشرح المطلوب مفصلا.rar

[أبوعيد]

السلام عليكم

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

أنت تقول لا بد من تطابق الأعمدة تماما , وبالنظر إلى ملفك الأخير المرفق وجد اختلاف في العمود الأول

فكيف الحل ؟

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

لابد من صياغة الطلب بشكل جديد وبمنطق صحيح لكي تجد الحل المناسب ...

[ابو وسام محمد]

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

الاخ ابو عيد جزاه الله خير نبهني له

وهو رقم المستند فقط غير مطلوب مطابقته لكامل الصف في الاعمدة كلها .

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

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

حيث أنني لم أفهم المنطق في مشاركتك الأخيرة بشكل صحيح ..

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

يرجى مزيد من التوضيح

[ابو وسام محمد]

يا اخواني الكرام

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

مطابقة كل رقم  معكوس سواء واحد او مكرر بما يقابلة بالموجب سواء واحد او مكرر  مطابقة تامة عدا العمود الاول وهو رقم المستند

بمعنى رقم - 2000 يقابله الرقم الموجب له فقط اقصد كل مبلغ واحد مع عكسه فقط من غير تكرار الا اذا وجد عكس يقابله

 

اعتقد كذا وضح المطلوب

 

شاكر ومقدر وقتكم الثمين

 

[أبوعيد]

جرب المرفق

 

test1.rar

[ابو وسام محمد]

الشكر لله اولا ثم لكم جميعا

المطلوب وزيادة

بارك الله فيكم جميعا

وشكرا للحركات الحلوة لاخ ابو عيد

المطلوب 100%

[سليم حاصبيا]

اخيراً وجدتــها  (اذا لا يهمك التكرار في العامود A)

بدون Vba

test1 salim.rar

[ابو وسام محمد]

اخي سليم

يعطيك العافية على الجهد المبذول منك ومن زملاؤك في المنتدى 

لقد اجاد واصاب اخوي ابو عيد بالحل ولن انسى جهدكم جميعا لما قدمتوموه من حلول كلا حسب طريقته 

ولدي ملفات اخرى تتعلق بنفس الموضوع وما هذا الا الخطوة الاولى 

جزاكم الله خير

[ابو وسام محمد]

طلب اخير في الملف الذي تم حله الاخ ابو عيد

ان يجعل امتداد المعادلة الى اخر سطر في الملف لكون الملف المرسل هو جزء مختصر فقط

ولك تحياتي

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

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

كم عدد الصفوف لديك؟

[ابو وسام محمد]

صدقت اخوي ياسر

مشكور عالتوضيح 

 

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

2 ساعات مضت, ابو وسام محمد said:

صدقت اخوي ياسر

مشكور عالتوضيح 

 

فكرتني بكلمة عالتوضيح بأخ حبيب وغالي ..كان يقولي :تعشب شاي ..

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

تقبل تحياتي