مطلوب احصائية من نوع مختلف

[boalaoi]

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

مطلوب حالة مستعجله 

عندي مبالغ مكافئات واريد حسابها بشكل تلقائي بمسير اجمالي 

الجهه اليمنى جهة المدخلات 

الجهه اليسرى جهه المخرجات ( الاحصائية ) 

لا تبخلون علينا بمساعدتكم 

تم تعديل يناير 22, 2017 بواسطه boalaoi

[أبوعيد]

وعليكم السلام 

أهلا بك أهي في هذا المنتدى الرجاء إرقاق الملف للعمل عليه

[boalaoi]

انا في الشركة 

وكمبيوتر الشركة مقفل لا توجد به برامج لفك الضغط 

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

ضروري ارفقه بصيغه rar 

 

انا الان محتاج جمع الاسماء من الجهه اليمنى الى الجهه اليسرى تلقائياً بالاضافه الى حذف الاسماء المتكرره تلقائياً 

والمكافئات انا استخرجت الدالة المطلوب 

انا الان فقط احتاج جمع الاسماء وحذف المتكرر تلقائياُ 

 

 

[boalaoi]

 

 

للرفع 

[boalaoi]

up

 

للرفع 

[boalaoi]

up

 

 

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

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

[طائع]

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

 

احصائية من نوع مختلف.rar

[boalaoi]

صباحكم عسل 

تم رفع الملف بعد التعديل بناء على طلبكم 

المطلوب ترحيل الاسماء من الجهه اليمنى ( المسير الاجمالي ) وحذف الاسماء المتكرره ووضعهم بالجهه اليسرى ( المسير الافرادي ) 

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

جزيتم خيراً

احصائية من نوع مختلف بعد التعديل .rar

[أبوعيد]

أخي العزيز

القائمة الموجودة على اليسار صحيحة ولا تحتاج أي فرز

اكتب في اليسار جميع الموظفين والدالة الموجودة ستحسب إجمالي المكافأة

تحياتي

[boalaoi]

جهه اليسار مخرجات

جهه اليمين مدخلات

لتسهيل وسرعه العمل 

وتقليل الاخطاء 

قد يحدث نسيان للموظف في الترحيل للجهه اليسرى

خصوصاً ان المسيرات الافراديه التي اعمل عليها عددها يتفاوت بين 10 الى 30 مسير افرادي 

 

 

 

 

 

 

تم تعديل يناير 25, 2017 بواسطه boalaoi

[boalaoi]

up

[أبوعيد]

السلام عليكم

أخي العزيز اكتب كل الموظفين اللي عندك في الناحية اليسرى (اكتبهم يدويا) بدون أن تنسى أحدأ

هذه القائمة ستكون ثابتة دائما لن تتغير 

القائمة التي ستكتبها يدويا في اليسار ستكون ثابتة لن تتغير مهما تغيرت القوائم في اليمين

مثلا لو كتبت في السار موظف ليس له مكافأة ستكون مكافأته صفر

أرجو أن تكون قد فهمت مقصدى

تحياتي

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

جرب الكود التالي

Sub ListUnique()
    'Reference : Microsoft Scripting Runtime
    '---------------------------------------
    Dim d       As Scripting.Dictionary
    Dim r       As Long
    Dim m       As Long
    
    Set d = CreateObject("Scripting.Dictionary")
    m = Range("A" & Rows.Count).End(xlUp).Row
    
    For r = 1 To m
        If Range("B" & r).Value <> "" And IsNumeric(Range("B" & r).Value) And Range("A" & r).Value <> "المجموع" Then
            If Not d.Exists(Key:=Range("A" & r).Value) Then
                d.Add Key:=Range("A" & r).Value, Item:=Range("B" & r).Value
            Else
                d(Range("A" & r).Value) = d(Range("A" & r).Value) + Range("B" & r).Value
            End If
        End If
    Next r
    
    Range("F:G").ClearContents
    Range("F2:G2").Value = Array("اسم الموظف", "مجموع المكافآت")
    Range("F3").Resize(d.Count, 1).Value = Application.Transpose(d.Keys)
    Range("G3").Resize(d.Count, 1).Value = Application.Transpose(d.Items)
    Set d = Nothing
End Sub

 

[boalaoi]

up

في ٢٦‏/١‏/٢٠١٧ at 16:25, ياسر خليل أبو البراء said:

جرب الكود التالي

Sub ListUnique()
    'Reference : Microsoft Scripting Runtime
    '---------------------------------------
    Dim d       As Scripting.Dictionary
    Dim r       As Long
    Dim m       As Long
    
    Set d = CreateObject("Scripting.Dictionary")
    m = Range("A" & Rows.Count).End(xlUp).Row
    
    For r = 1 To m
        If Range("B" & r).Value <> "" And IsNumeric(Range("B" & r).Value) And Range("A" & r).Value <> "المجموع" Then
            If Not d.Exists(Key:=Range("A" & r).Value) Then
                d.Add Key:=Range("A" & r).Value, Item:=Range("B" & r).Value
            Else
                d(Range("A" & r).Value) = d(Range("A" & r).Value) + Range("B" & r).Value
            End If
        End If
    Next r
    
    Range("F:G").ClearContents
    Range("F2:G2").Value = Array("اسم الموظف", "مجموع المكافآت")
    Range("F3").Resize(d.Count, 1).Value = Application.Transpose(d.Keys)
    Range("G3").Resize(d.Count, 1).Value = Application.Transpose(d.Items)
    Set d = Nothing
End Sub

 

يعطيك العافيه لجهودكـ ابو البراء

وضعته ولم استفيد 

 

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

يرجى عدم وضع اقتباسات طويلة .. المهم

كيف وضعته؟ .. ما المشكلة التي حدثت معك بالضبط

كن دقيقاً في وصف المشكلة لتجد المساعدة بشكل أفضل

[boalaoi]

انا لا اجيد اضافة الكود بالاكسل 

اتبعت خطوات اضافة الكود من منتدى اخر 

 واضفت الكود 

وشغلته 

ولم يعمل بالشكل المطلوب وكاني لم افعل شي 

 

الله يعطيك العافيه 

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

جزيت خيراً 

 

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

أخي الكريم أنا لا أرفق الملفات في الطلبات إلا للضرورة القصوى

لابد من معرفة الأساسيات للتعامل مع الأكواد

افتح محرر الأكواد عن طريق Alt + F11 .. قم بإدراج موديول جديد من قائمة Insert ثم Module

انسخ الكود من الموضوع والصقه في الموديول ..

احفظ الملف ..إذا ظهرت لك رسالة فيها Yes و No و Cancel ، اختر الخيار No وغير امتداد الملف ليقبل الأكواد Macro-Enabled ...

أخيراً اذهب لمحرر الأكواد مرة أخرى ومن قائمة Tools ثم References أضف المكتبة المشار إليها في أول الكود وهي Microsoft Script Runtime ..

 

الآن قم بربط الكود بزر أمر أو أي شكل وشغل الكود

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

تقبل تحياتي

[boalaoi]

جزيت خيراً 

الله يعطيك العافيه 

حاولت تكراراً ان اضع الكود الى ان وصلت الى النتيجة والحمد لله اشتغل الكود 

لاكن السؤال هل يمكنك ان تغير في الكود بحيث يستخرج  كم مرة تكرر الاسم في الجهه اليسرى بجانب الاسم 

[boalaoi]

up

[boalaoi]

up

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

السلام عليكم

لا أتذكر الموضوع في الحقيقة .. لقد مر عليه فترة من الوقت

هل المطلوب عدد مرات تكرار الاسم بعد النتائج أم قبلها؟

[boalaoi]

وعليكم السلام 

المطلوب يضع في عمود H 

عدد تكرار الاسم في المسيرات الافرادية ووضع عدد التكرار الاسم في العمود H 

 

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

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