جمع اللون الاصفر بالخلية

[هشــــام الســـورى]

المطلوب جمع اللون الاصفر بالصف

اللون الاصفر معمول من CONDITION FORMAT

جمع الخلايا الملونة.rar

[مهند الزيدي]

السلام عليكم .. تقضل الحل عاى شكل دالة تقوم بجمع الخلايا الملونة حسب أختيارك

جمع الخلايا الملونة22.rar

[هشــــام الســـورى]

شكرا اخى مهند

بس تعال طبقها فى الملف المرسل لا تعمل  لانى عامل اللون CONDITION FORMATING

حاول تطبيقها

انا بحثت ولقيت بالفعل بالمنتدى ولكن عند التطبيق فى الشيت لاتعمل لان اللوا بيأتى AUTOMATIC  من CONDITION FORMATTING

افتح ملفى المرفق وانت هتفهم شو قصدى

[هشــــام الســـورى]

ارجوا مساعدتى فى هذا الملف

[أبوبسمله]

جمع بناء على لون الخليه

أخى الكريم

اتفضل راجع الموضوع ده هتلاقى فيه ما تريد ان شاء الله

بالتوفيق

 

 

[رجب جاويش]

أخى الفاضل

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

Sub CountCells()
    Dim Cel As Range, x
    Dim Total As Integer
    Application.ScreenUpdating = False
            For Each Cel In ActiveSheet.Range("d7:J7")
                x = GetCellColorForReals(Cel)
                If x <> 16777215 Then
                Total = Total + Cel.Value
                End If
            Next Cel
            Range("L7") = Total
    Application.ScreenUpdating = False
End Sub

Function GetCellColorForReals(R As Range) As Long
    GetCellColorForReals = R.DisplayFormat.Interior.Color
End Function

 

[أبوبسمله]

جزاك الله خيرا اخى رجب

بالتوفيق اخى رجب

[مهند الزيدي]

شكراً لك اخي العزيز " رجب جاويش " .. وفقك الله لكل خير...

ممكن تعديل الكود بحيث نختار جمع لون معين بنا على التنسيق الشرطي في الكود

[هشــــام الســـورى]

يرجى الاساتذة ايجاد الملف المرفق 

لا يجمع بردة فى حالة condition formating

جمع اللون الاحمر.rar

[مهند الزيدي]

Sub CountCells()
    Dim Cel As Range, x
    Dim Total As Integer
    Application.ScreenUpdating = False
            For Each Cel In ActiveSheet.Range("d7:J7")
                x = GetCellColorForReals(Cel)
                If x <> 16777215 Then
                Total = Total + Cel.Value
                End If
            Next Cel
            Range("K7") = Total
    Application.ScreenUpdating = False
End Sub

Function GetCellColorForReals(R As Range) As Long
    GetCellColorForReals = R.DisplayFormat.Interior.Color
End Function

Sub CountCells()
    Dim Cel As Range, x
    Dim Total As Integer
    Application.ScreenUpdating = False
            For Each Cel In ActiveSheet.Range("d7:J7")
                x = GetCellColorForReals(Cel)
                If x <> 16777215 Then
                Total = Total + Cel.Value
                End If
            Next Cel
            Range("K7") = Total
    Application.ScreenUpdating = False
End Sub

Function GetCellColorForReals(R As Range) As Long
    GetCellColorForReals = R.DisplayFormat.Interior.Color
End Function

[رجب جاويش]

جرب الملف المرفق

 

جمع اللون الاحمر.rar

[مهند الزيدي]

كود للأخ رجب جاويش ضعه بدل الكود في المرفق

[هشــــام الســـورى]

طلعلى error 438 

لما دوست على جمع

وغيرد الكود بالفعل وبردة نفس المشكلة

ياجماعة لو حد عايز يعمل ملف تانى غير بتاعى بس نفس الفكرة ماشىيكون الارقام  بين 100 و 500 معمولين باللون الاحمر با condition formation

 

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

تم تعديل فبراير 9, 2016 بواسطه أتـــــــــش

[أبوبسمله]

هو نفس الملف بس بعد الحفظ بطريقه اخرى

جرب كده اخى وقلنا لانه بيعمل بشكل طبيعى

جمع اللون الاحمر1.rar

[هشــــام الســـورى]

نفس المشكلة بنفس الخطأ

يظهر كدة ان العيب من عندى

طيب ينفع الغى كلمه الجمة وتتعمل AUTo

كدة ممكن تتحل المشكلة وتشتغل عندى وعندك

 

[ياسر العربى]

تفضل فكرة جميلة لعلها تفي بالغرض

طبعا مطبق في المثال اذا كان الرقم اكبر من 100 او اقل من 500 يتغير للون الاحمر ويتم جمعه

جمع الخلايا الملونة.rar

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

بارك الله فيكم إخواني وأحبابي على الحلول الجميلة

أخي الكريم إتش

جرب الملف التالي عله يفيدك ..

Sub CountSumCF()
    Dim Ws As Worksheet, I As Integer, J As Integer
    
    Application.ScreenUpdating = False
        For Each Ws In ThisWorkbook.Worksheets
            Ws.Activate
            I = I + CountCFCells(Ws.Range("A1").CurrentRegion, Sheet1.Range("F1"), False)
            J = J + CountCFCells(Ws.Range("A1").CurrentRegion, Sheet1.Range("F1"), True)
        Next Ws
        
        MsgBox "Yellow Cells In All Sheets Count = " & I & vbNewLine & "Yellow Cells In All Sheets SUM = " & J
        Sheet1.Activate
    Application.ScreenUpdating = True
End Sub

Function CountCFCells(Rng As Range, C As Range, bCount As Boolean)
    Dim I As Single, J As Long
    Dim Chk As Boolean, Str1 As String, CFCELL As Range
    Application.Volatile
    Chk = False
    
    For I = 1 To Rng.FormatConditions.Count
        If Rng.FormatConditions(I).Interior.ColorIndex = C.Interior.ColorIndex Then
            Chk = True
            Exit For
        End If
    Next I
    
    J = 0
    If Chk = True Then
        For Each CFCELL In Rng
            Str1 = CFCELL.FormatConditions(I).Formula1
            Dim II As Integer
            Dim IIFlg As Boolean
            Dim Tmp
            IIFlg = False
            For II = 1 To Len(Str1)
                Tmp = Mid(Str1, II, 1)
                If ("0123456789" Like "*" & Tmp & "*") Then
                    IIFlg = True
                Else
                    If (IIFlg) Then Exit For
                End If
            Next
            Tmp = Right(Str1, Len(Str1) - II + 1)
            Str1 = "=" & CFCELL.Address & Tmp
            If bCount = False Then
                If Evaluate(Str1) = True Then J = J + 1
            Else
                If Evaluate(Str1) = True Then J = J + CFCELL
            End If
        Next CFCELL
    Else
        CountCFCells = "Color Not Found"
        Exit Function
    End If
    CountCFCells = J
    Set Rng = Nothing
    Set C = Nothing
End Function

تقبل تحياتي

Count & Sum Conditional Formatting Cells YasserKhalil.rar