Function ColorSum(rngCells As Range) As Double
Application.Volatile
Dim cell As Range
ColorSum = 0 'Toplamaya kaçtan başlanacak
On Error Resume Next
For Each cell In rngCells
If cell.Font.ColorIndex = 10 Then ColorSum = ColorSum + cell.Value
Next cell
End Function
Function SumColor(rColor As Range, rSumRange As Range)
''''''''''''''''''''''''''''''''''''''
'Written by Ozgrid Business Applications
'www.ozgrid.com
'Sums cells based on a specified fill color.
'''''''''''''''''''''''''''''''''''''''
Dim rCell As Range
Dim iCol As Integer
Dim vResult
iCol = rColor.Interior.ColorIndex
For Each rCell In rSumRange
If rCell.Interior.ColorIndex = iCol Then
vResult = WorksheetFunction.Sum(rCell) + vResult
End If
Next rCell
SumColor = vResult
End Function
Function CountColor(rColor As Range, rSumRange As Range)
''''''''''''''''''''''''''''''''''''''
'Written by Ozgrid Business Applications
'www.ozgrid.com
'Counts cells based on a specified fill color.
'''''''''''''''''''''''''''''''''''''''
Dim rCell As Range
Dim iCol As Integer
Dim vResult
iCol = rColor.Interior.ColorIndex
For Each rCell In rSumRange
If rCell.Interior.ColorIndex = iCol Then
vResult = vResult + 1
End If
Next rCell
CountColor = vResult
End Function
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Application.ScreenUpdating = False
Calculate
'Application.ScreenUpdating = True
End SubDosyayı indir
Siz değerli Excel dostlarına yıllarca hizmet verdiğimiz ve şu an kapalı bulunan www.kod.gen.tr forum, devamı...
