サンプルマクロは、文字色、背景色をキーとして抽出し、そのセル範囲の
合計を出す関数です。
Function Sample(合計範囲 As Range, _
Optional 文字色指定セル As Range, _
Optional 背景色指定セル As Range) As Double
Dim myFlag As Byte, f As Boolean
Dim myCell As Range
Dim myFontCell As Range, myBackCell As Range
Dim myFontClr() As Long, myBackClr() As Long
Dim myCnt As Long
Application.Volatile
myFlag = 3
If 文字色指定セル Is Nothing Then myFlag = myFlag - 2
If 背景色指定セル Is Nothing Then myFlag = myFlag - 1
If Int(myFlag / 2) = 1 Then
For Each myFontCell In 文字色指定セル
myCnt = myCnt + 1
ReDim Preserve myFontClr(1 To myCnt)
myFontClr(myCnt) = myFontCell.Font.Color
Next
End If
myCnt = 0
If myFlag Mod 2 = 1 Then
For Each myBackCell In 背景色指定セル
myCnt = myCnt + 1
ReDim Preserve myBackClr(1 To myCnt)
myBackClr(myCnt) = myBackCell.Interior.Color
Next
End If
Set myRng = Nothing
For Each myCell In 合計範囲
f = False
Select Case myFlag
Case 0
f = True
Case 1
For myCnt = 1 To 背景色指定セル.Cells.Count
If myCell.Interior.Color = myBackClr(myCnt) Then
f = True
Exit For
End If
Next
Case 2
For myCnt = 1 To 文字色指定セル.Cells.Count
If myCell.Font.Color = myFontClr(myCnt) Then
f = True
Exit For
End If
Next
Case 3
For myCnt = 1 To 背景色指定セル.Cells.Count
If myCell.Interior.Color = myBackClr(myCnt) Then _
Exit For
Next
If myCnt <= 背景色指定セル.Cells.Count Then
For myCnt = 1 To 文字色指定セル.Cells.Count
If myCell.Font.Color = myFontClr(myCnt) Then
f = True
Exit For
End If
Next
End If
End Select
If f Then
If myRng Is Nothing Then Set myRng = myCell _
Else Set myRng = Union(myRng, myCell)
End If
Next
Sample = Application.WorksheetFunction.Sum(myRng)
End Function
|