快速定製Excel VBA功能

Question

我有一個自定義函數用於計算或求和我有多少個彩色單元格。這是函數：

Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As Boolean) 

    Application.Volatile (True) 

    Dim rCell As Range 
    Dim lCol As Long 
    Dim vResult 

    lCol = rColor.Interior.ColorIndex 

    If SUM = True Then 
     For Each rCell In rRange 
      If rCell.Interior.ColorIndex = lCol Then 
       vResult = WorksheetFunction.SUM(rCell, vResult) 
      End If 
     Next rCell 
    Else 
     For Each rCell In rRange 
      If rCell.Interior.ColorIndex = lCol Then 
       vResult = 1 + vResult 
      End If 
     Next rCell 
    End If 

ColorFunction = vResult 

End Function 

---

它是通過輸入下面的函數調用：

=colorfunction($A$1,A2:C2,FALSE) 

或

=colorfunction($A$1,A2:C2,TRUE) 

其中：

• A1 =與背景色的細胞進行檢查
• A2：C2 =範圍要被計數
• FALSE/TRUE =計數或薩姆

---

我的問題是：有什麼我可以做到VBA加快這個功能？

我試圖用WorksheetFunction部分進行實驗，但無法找到有效的語法。任何其他想法？

Answer 1

試試：

Function ColorFunction2(rColor As Range, rRange As Range, _ 
         Optional pSUM As Boolean) As Variant 
Dim rCell As Range 
Dim lCol As Long 
Dim vResult As Variant, vTmp As Variant ' for intermediate calcs, _ 
              for clear vision of logic, _ 
              for not doubling code 
    Application.Volatile (True) 

    lCol = rColor.Interior.ColorIndex 

    For Each rCell In rRange.Cells ' expicit .Cells 
     If rCell.Interior.ColorIndex = lCol Then 
      Select Case pSUM ' SUM is reserved word 
       Case True: vTmp = rCell.Value ' out of sheet functions calling 
       Case False: vTmp = 1 
     ' change True-False sequence according to real probability they occures 
      End Select 
     End If 
     vResult = vResult + vTmp 
    Next ' rCell ' No need 

    ColorFunction2 = vResult 
End Function 

新增expicit 「爲Variant」