Добрый день, столкнулся с проблемой. Необходим скрипт VBA для суммы по цвету шрифта, на просторах интернета такое имеется, но только для версий Excel 2010 +, а на работе версия 1997-2003-- не принимает код и выводит ошибку в цикле VBA. Помогите пожалуйста с изменением кода под версию Excel 97-03 либо если имеются "ГУРУ Excel" подскажите скрипт VBA. Спасибо. P.S. скрипт прикрепляю ниже
---------------------------- Function GetCellColor(xlRange As Range) Dim indRow, indColumn AsLong Dim arResults()
Application.Volatile
If xlRange IsNothingThen Set xlRange = Application.ThisCell EndIf
If xlRange.Count > 1Then ReDim arResults(1To xlRange.Rows.Count, 1To xlRange.Columns.Count) For indRow = 1To xlRange.Rows.Count For indColumn = 1To xlRange.Columns.Count
arResults(indRow, indColumn) = xlRange(indRow, indColumn).Interior.Color Next Next
GetCellColor = arResults Else
GetCellColor = xlRange.Interior.Color EndIf EndFunction
Function GetCellFontColor(xlRange As Range) Dim indRow, indColumn AsLong Dim arResults()
Application.Volatile
If xlRange IsNothingThen Set xlRange = Application.ThisCell EndIf
If xlRange.Count > 1Then ReDim arResults(1To xlRange.Rows.Count, 1To xlRange.Columns.Count) For indRow = 1To xlRange.Rows.Count For indColumn = 1To xlRange.Columns.Count
arResults(indRow, indColumn) = xlRange(indRow, indColumn).Font.Color Next Next
GetCellFontColor = arResults Else
GetCellFontColor = xlRange.Font.Color EndIf
EndFunction
Function CountCellsByColor(rData As Range, cellRefColor As Range) AsLong Dim indRefColor AsLong Dim cellCurrent As Range Dim cntRes AsLong
Application.Volatile
cntRes = 0
indRefColor = cellRefColor.Cells(1, 1).Interior.Color For Each cellCurrent In rData If indRefColor = cellCurrent.Interior.Color Then
cntRes = cntRes + 1 EndIf Next cellCurrent
CountCellsByColor = cntRes EndFunction
Function SumCellsByColor(rData As Range, cellRefColor As Range) Dim indRefColor AsLong Dim cellCurrent As Range Dim sumRes
Application.Volatile
sumRes = 0
indRefColor = cellRefColor.Cells(1, 1).Interior.Color For Each cellCurrent In rData If indRefColor = cellCurrent.Interior.Color Then
sumRes = WorksheetFunction.Sum(cellCurrent, sumRes) EndIf Next cellCurrent
SumCellsByColor = sumRes EndFunction
Function CountCellsByFontColor(rData As Range, cellRefColor As Range) AsLong Dim indRefColor AsLong Dim cellCurrent As Range Dim cntRes AsLong
Application.Volatile
cntRes = 0
indRefColor = cellRefColor.Cells(1, 1).Font.Color For Each cellCurrent In rData If indRefColor = cellCurrent.Font.Color Then
cntRes = cntRes + 1 EndIf Next cellCurrent
CountCellsByFontColor = cntRes EndFunction
Function SumCellsByFontColor(rData As Range, cellRefColor As Range) Dim indRefColor AsLong Dim cellCurrent As Range Dim sumRes
Application.Volatile
sumRes = 0
indRefColor = cellRefColor.Cells(1, 1).Font.Color For Each cellCurrent In rData If indRefColor = cellCurrent.Font.Color Then
sumRes = WorksheetFunction.Sum(cellCurrent, sumRes) EndIf Next cellCurrent
Добрый день, столкнулся с проблемой. Необходим скрипт VBA для суммы по цвету шрифта, на просторах интернета такое имеется, но только для версий Excel 2010 +, а на работе версия 1997-2003-- не принимает код и выводит ошибку в цикле VBA. Помогите пожалуйста с изменением кода под версию Excel 97-03 либо если имеются "ГУРУ Excel" подскажите скрипт VBA. Спасибо. P.S. скрипт прикрепляю ниже
---------------------------- Function GetCellColor(xlRange As Range) Dim indRow, indColumn AsLong Dim arResults()
Application.Volatile
If xlRange IsNothingThen Set xlRange = Application.ThisCell EndIf
If xlRange.Count > 1Then ReDim arResults(1To xlRange.Rows.Count, 1To xlRange.Columns.Count) For indRow = 1To xlRange.Rows.Count For indColumn = 1To xlRange.Columns.Count
arResults(indRow, indColumn) = xlRange(indRow, indColumn).Interior.Color Next Next
GetCellColor = arResults Else
GetCellColor = xlRange.Interior.Color EndIf EndFunction
Function GetCellFontColor(xlRange As Range) Dim indRow, indColumn AsLong Dim arResults()
Application.Volatile
If xlRange IsNothingThen Set xlRange = Application.ThisCell EndIf
If xlRange.Count > 1Then ReDim arResults(1To xlRange.Rows.Count, 1To xlRange.Columns.Count) For indRow = 1To xlRange.Rows.Count For indColumn = 1To xlRange.Columns.Count
arResults(indRow, indColumn) = xlRange(indRow, indColumn).Font.Color Next Next
GetCellFontColor = arResults Else
GetCellFontColor = xlRange.Font.Color EndIf
EndFunction
Function CountCellsByColor(rData As Range, cellRefColor As Range) AsLong Dim indRefColor AsLong Dim cellCurrent As Range Dim cntRes AsLong
Application.Volatile
cntRes = 0
indRefColor = cellRefColor.Cells(1, 1).Interior.Color For Each cellCurrent In rData If indRefColor = cellCurrent.Interior.Color Then
cntRes = cntRes + 1 EndIf Next cellCurrent
CountCellsByColor = cntRes EndFunction
Function SumCellsByColor(rData As Range, cellRefColor As Range) Dim indRefColor AsLong Dim cellCurrent As Range Dim sumRes
Application.Volatile
sumRes = 0
indRefColor = cellRefColor.Cells(1, 1).Interior.Color For Each cellCurrent In rData If indRefColor = cellCurrent.Interior.Color Then
sumRes = WorksheetFunction.Sum(cellCurrent, sumRes) EndIf Next cellCurrent
SumCellsByColor = sumRes EndFunction
Function CountCellsByFontColor(rData As Range, cellRefColor As Range) AsLong Dim indRefColor AsLong Dim cellCurrent As Range Dim cntRes AsLong
Application.Volatile
cntRes = 0
indRefColor = cellRefColor.Cells(1, 1).Font.Color For Each cellCurrent In rData If indRefColor = cellCurrent.Font.Color Then
cntRes = cntRes + 1 EndIf Next cellCurrent
CountCellsByFontColor = cntRes EndFunction
Function SumCellsByFontColor(rData As Range, cellRefColor As Range) Dim indRefColor AsLong Dim cellCurrent As Range Dim sumRes
Application.Volatile
sumRes = 0
indRefColor = cellRefColor.Cells(1, 1).Font.Color For Each cellCurrent In rData If indRefColor = cellCurrent.Font.Color Then
sumRes = WorksheetFunction.Sum(cellCurrent, sumRes) EndIf Next cellCurrent