اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر (معدل)

تمام يا أخ سليم بارك الله فيك

ولكن

هناك ملحوظة صغيرة

1- هل من الممكن جعل تحديث المبلغ وعدد التكرار تلقائي

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

2- يكون إستخراج الإسم والمبلغ وعدد مرات التكرار من شيت 2 ( الذي إسمه الخارج ) إلي شيت 3 ( المستفيدين )

 

تكرار.rar

تم تعديل بواسطه Mahmoud330
قام بنشر (معدل)

الأخ الفاضل سليم حاصيبا

دائماً ماتفاجأني بإسلوبك الجديد

ولكن أفضل أن يكون هناك زر لتشغيل المايكرو في صفحة المستفيدين

مع مراعاة جعل تحديث المبلغ وعدد التكرار تلقائي بدون الضغط علي زرتشغيل المايكو

تم تعديل بواسطه Mahmoud330
قام بنشر

أستاذ سليم بارك الله فيك

ولكن أعذرني لي ملاحظة صغيرة

1- فأنا أريد التحديث التلقائي يكون بدون الذهاب إلي صفحة المستفيدن والعودة مرة أخري .

2- ألا يشترط التحديث التلقائي الإنتقال إلي العمود C أو E ولكن من المفترض أن يكون كلاهما

ولكن حضرتك جعلت الكود لا يعمل اوتوماتيكياً الا اذا حدث تغيير في اي خلية من العامود C لذا يجب أولاً كتابة الاسم و من ثم اختيار المبلغ .

تكرار تلقائي.rar

 

وهذا ملف آخر للعلامة أ- ياسر خليل

الذي أريد أن يكون التكرارالتلقائي مثل ذلك

Count Distinct.rar

 

قام بنشر

الأخ الكريم محمود

أما آن لك ان تقوم بتغيير اسم الظهور للغة العربية

 

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

Sub UniqueItems()
'يقوم الكود باستخراج القيم الغير مكررة أي الفريدة وعدها
'-------------------------------------------------------
'تعريف المتغيرات
    Dim R As Range, Cel As Range, LR As Long, D, A
'تحديد آخر خلية بها بيانات في أي عمود
    LR = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).Row
'تحديد النطاق المراد العمل عليه واستخراج القيم الفريدة منه
    Set R = Range("A1:E" & LR)
'تعيين المتغير لتخزين القيم الفريدة داخله
    Set D = CreateObject("Scripting.Dictionary")
'جملة لتجنب ظهور رسائل خطأ أثناء تنفيذ الكود
    On Error Resume Next
'مسح محتويات النطاق الذي ستظهر فيه النتائج
    Range("I2:J500").ClearContents
'حلقة تكرارية لكل خلية داخل خلايا النطاق
    For Each Cel In R
'إذا لم تكن الخلية قيمتها صفر يتم إضافة العنصر للمتغير المخصص لذلك
        If Cel <> 0 Then D.Add CStr(Cel), CStr(Cel)
    Next
'تعيين المتغير ليساوي العناصر الفريدة التي تم تخزينها داخل المتغير الأول
    A = D.Items
'إظهار النتائج بعد تحويلها إلى شكل رأسي حيث أن المتغير يخزن القيم على شكل مصفوفة
    Range("I2").Resize(D.Count) = Application.Transpose(A)
'إظهار نتائج عد القيم
    Range("J2").Resize(D.Count).FormulaR1C1 = "=COUNTIF(R1C1:R100C5,RC[-1])"
End Sub

تقبل تحياتي

Count Unique Items Automatically.rar

  • Like 1
قام بنشر

جرب هذا التعديل

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 3 Or Target.Column = 5 Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Unique
    End If
    Sheets("الخارج").Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub


قام بنشر

أ. ياسر مجهود وفكر رائع

ولكن

واجهتنا مشكلة أخري وهي

- عند الضغط علي زر تحديث القائمةفي صفحة المستبعدين يتم الإنتقال إلي صفحة الخارج . وهذا غير مطلوب

- المطلوب هو :- أن يتم تحديث قائمة المستفيدين بدون الإنتقال إلي صفحة أخري أو أن يكون هناك إهتزاز للشاشة

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information