即効テクニック |
サンプルマクロは、文字色、背景色をキーとして合計範囲のうち抽出的に合計を出す関数です。
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