أكاديمية الصقر للتدريب

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


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





عد الخلايا الملونه بشرطين

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


موضوع مغلق

الصفحة 1 من 2 < 1 2 > الأخيرة »


15-08-2020 08:28 مساء
محمد محمد حمودة
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 11-05-2018
رقم العضوية : 6221
المشاركات : 60
الجنس : ذكر
تاريخ الميلاد : 29-1-1984
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 62
 offline 

السلام عليكم ورحمة الله وبركاته
استخدمت داله معرفه بهذا الملف لكن الملف اصبح ثقيل جدااااااااا..نظرا لكثرة البيانات.واجد صعوبه بالغه في التعامل معه ...ما اريده هو: 
عد الخلايا التي تحتوي على لون معين( وهو اللون الموجود بالملف )...ويكون بها الرقم اكبر من او يساوي 48...حينها يتم العد.
هل ممكن كود بدلا من الداله المعرفه.
 
 
  عد خلايا بشرطين.rar   تحميل rar مرات التحميل :(1)
الحجم :(332.246) KB



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


Dim D As Worksheet
Dim Im As Worksheet
Dim i, s#

Sub find_nageh()
Set D = sheets("data")
Set Im = sheets("Import")

For i = 1 To 4
  Call Find_sum_nageh(D.Range("E4:H100"), i, Im.Range("C5"))
  Im.Range("J12").Offset(i - 1) = s
  s = 0
  
  Call Find_sum_Raseb(D.Range("E4:H100"), i, Im.Range("C5"))
  Im.Range("K12").Offset(i - 1) = s
  s = 0
  
  Call Find_sum_Gha3eb(D.Range("E4:H100"), i, Im.Range("C7"))
  Im.Range("L12").Offset(i - 1) = s
  s = 0
  
  Call Find_sum_special(D.Range("E4:H100"), i, Im.Range("C6"))
  Im.Range("K12").Offset(i - 1) = Im.Range("K12").Offset(i - 1) + s
  s = 0
 Next
Set D = Nothing: Set Im = Nothing
End Sub
'+++++++++++++++++++++++++++++
Sub Find_sum_nageh(Tot_rg As Range, ByVal n%, Alama#)
 For Each cel In Tot_rg.Columns(n).Cells
    If IsNumeric(cel) And cel >= Alama Then
        If cel.Interior.ColorIndex <> xlNone Then
            s = s + 1
        End If
   End If
 Next

End Sub
'+++++++++++++++++++++++++++++
Sub Find_sum_Gha3eb(Tot_rg As Range, ByVal n%, Alama)
 For Each cel In Tot_rg.Columns(n).Cells
    If cel = Alama Then
       If cel.Interior.ColorIndex <> xlNone Then
       s = s + 1
       End If
    End If
 Next

End Sub
'++++++++++++++++++++++++++++++
Sub Find_sum_Raseb(Tot_rg As Range, ByVal n%, Alama)
 For Each cel In Tot_rg.Columns(n).Cells
    If IsNumeric(cel) And cel < Alama Then
        If cel.Interior.ColorIndex <> xlNone Then
           s = s + 1
           
        End If
   End If
 Next

End Sub

'+++++++++++++++++++++++++++
Sub Find_sum_special(Tot_rg As Range, ByVal n%, Alama)
 For Each cel In Tot_rg.Columns(n).Cells
    If cel = Alama Then
        If cel.Interior.ColorIndex <> xlNone Then
           s = s + 1
        End If
   End If
 Next

End Sub


 
عرض الإجابة




15-08-2020 09:21 مساء
مشاهدة مشاركة منفردة [1]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif عد الخلايا الملونه بشرطين
لا حاجة للألوان في هذه الحالة

Function Count_nageh(rg As Range, ComP As Range)
Dim cel As Range, s%
For Each cel In rg.Cells
    If IsNumeric(cel) And cel >= ComP Then
        s = s + 1
    End If
Next
Count_nageh = s
End Function
'++++++++++++++++++++++++++
Function Count_Raseb(rg As Range, ComP As Range)
Dim cel As Range, s%
For Each cel In rg.Cells
  If IsNumeric(cel) And cel < ComP Then
      s = s + 1
  End If
Next
Count_Raseb = s
End Function
'+++++++++++++++++++++++++++++++
Function Count_Ga3eb(rg As Range, ComP As Range)
Dim cel As Range, s%
For Each cel In rg.Cells
    If cel = ComP Then
      s = s + 1
    End If
Next
Count_Ga3eb = s
End Function

الملف مرفق
 
 
  M_hammouda.xlsm   تحميل xlsm مرات التحميل :(4)
الحجم :(349.435) KB


15-08-2020 10:32 مساء
مشاهدة مشاركة منفردة [2]
محمد محمد حمودة
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 11-05-2018
رقم العضوية : 6221
المشاركات : 60
الجنس : ذكر
تاريخ الميلاد : 29-1-1984
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 62
 offline 
look/images/icons/i1.gif عد الخلايا الملونه بشرطين
جزاك الله خيرا استاذ سليم لكن استخدام اللون مهم جدااااااااا جدااااااااا جدااااااااا... لان في خلايا ناجحه غير مظلله....وخلايا ناجحه مظلله...
اريد( عد الخلايا الناجحه المظلله) فقط.
( عد الخلايا الراسبه المظلله).
(عد الخلايا المظلله الغياب)
؟؟؟؟؟؟؟؟؟؟

15-08-2020 10:41 مساء
مشاهدة مشاركة منفردة [3]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif عد الخلايا الملونه بشرطين
الماكرو لا ينظر الى لون الخلية
بل اذا كانت اكبر او تساوي  عدد معين او أصغر من نفس العدد او اذا كانت تساوي "غ"
بالنسبة للتضليل يمكن استعمال التنسيق الشرطي
على العموم مرفق ملف اخر يحتوي على كود 
يأخذ معطياته من الخلايا  C5 و C7
كما يحتوي على التنسيق الشرطي المطلو ب
(ازرق اكبر او يساوي الخلية  C5 اي ناجح  واصفر اذا كان غائباً)
الكود

Dim D As Worksheet
Dim Im As Worksheet
Dim i, s#
Sub find_nageh()
Set D = sheets("data")
Set Im = sheets("Import")
For i = 1 To 4
  Call Find_sum_nageh(sheets("data").Range("E4:H100"), i, Im.Range("C5"))
  Im.Range("J12").Offset(i - 1) = s
  s = 0
  Call Find_sum_Raseb(sheets("data").Range("E4:H100"), i, Im.Range("C5"))
  Im.Range("K12").Offset(i - 1) = s
  s = 0
  Call Find_sum_Gha3eb(sheets("data").Range("E4:H100"), i, Im.Range("C7"))
  Im.Range("L12").Offset(i - 1) = s
  s = 0
 Next
End Sub
'+++++++++++++++++++++++++++++
Sub Find_sum_nageh(Tot_rg As Range, ByVal n%, Alama#)
 For Each cel In Tot_rg.Columns(n).Cells
    If IsNumeric(cel) And cel >= Alama Then
    s = s + 1
   End If
 Next

End Sub
'+++++++++++++++++++++++++++++
Sub Find_sum_Gha3eb(Tot_rg As Range, ByVal n%, Alama)
 For Each cel In Tot_rg.Columns(n).Cells
    If cel = Alama Then
    s = s + 1
   End If
 Next

End Sub
'++++++++++++++++++++++++++++++
Sub Find_sum_Raseb(Tot_rg As Range, ByVal n%, Alama#)
 For Each cel In Tot_rg.Columns(n).Cells
    If IsNumeric(cel) And cel < Alama Then
    s = s + 1
   End If
 Next

End Sub

الملف المرفق يحتوي على الـــ  UDF والماكرو الجديد

 
 
  M_hammouda_Extra.xlsm   تحميل xlsm مرات التحميل :(3)
الحجم :(356.768) KB


15-08-2020 11:14 مساء
مشاهدة مشاركة منفردة [4]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif عد الخلايا الملونه بشرطين
ملف اخر كما تريده بالضبط
تظلل يدوياً ما تريد والكود يحسب لك ذلك
كذلك الـــ UDF
 
 
  M_hammouda_super.xlsm   تحميل xlsm مرات التحميل :(5)
الحجم :(356.82) KB


16-08-2020 08:42 صباحا
مشاهدة مشاركة منفردة [5]
محمد محمد حمودة
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 11-05-2018
رقم العضوية : 6221
المشاركات : 60
الجنس : ذكر
تاريخ الميلاد : 29-1-1984
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 62
 offline 
look/images/icons/i1.gif عد الخلايا الملونه بشرطين
اشكر حضرتك على الملف الرائع وهذا الاهتمام،،
الكود اسرع وافضل ولا يسبب ثقل للملف،،،
لكن ما ينقصه هو اعطائه أمر بتظليل الخلايا الزرقاء فقط؟؟؟!!!
حولت تعديل هذا السطر بالكود وتم بخير
فهل هناك اضافه أخرى..أو ملاحظه من سيادتكم
If cel.Interior.ColorIndex =24

16-08-2020 09:44 صباحا
مشاهدة مشاركة منفردة [6]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif عد الخلايا الملونه بشرطين
من باب الاختصار بالكتابة 
هذه الصورة
MLW2n_Hammouda_pic
 
 
 



الصفحة 1 من 2 < 1 2 > الأخيرة »


الكلمات الدلالية
الخلايا ، الملونه ، بشرطين ،


 










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

الساعة الآن 07:11 صباحا