Vba 具有用户设计函数的条件格式

总的来说，我的目标是创建一个VBA宏，该宏将遍历工作表，并使用用户设计的函数应用条件格式公式。工作表分为多个组，每个组有31行，因此我需要根据31进行步骤并设置条件格式。我创建了一个名为

identifFormulaCells

的自定义函数，该公式在条件格式中用于执行任何颜色、文本等操作

Function IdentifyFormulaCells(rng As Range) As Boolean
'   Determine if cell contains a formula based on input range and returns True if there is a formula

IdentifyFormulaCells = rng.HasFormula

End Function

Sub LoopGroup()

    Dim rng As Range
    Dim iRng As Range
    Dim iStep As Long
    Dim ProjectRow As Long
    Dim FormulaString As String

    Dim rngStart As Range
    Dim rngEnd As Range
    Dim iCol As Long
    Dim iRow As Long
    Dim nCol As Long
    Dim nRow As Long

    Set rng = Range("I34:FH994")

    nCol = rng.Columns.Count
    nRow = rng.Rows.Count

'Sets the first project row
    ProjectRow = 34
    FormulaString = "=IdentifyFormulaCells(I" & CStr(ProjectRow) & ")"

'Based on number of employees listed per project
    iStep = 31

    For iRow = 1 To nRow Step iStep
        MsgBox "Project Row before action = " & ProjectRow
        MsgBox "FormulaString before action = " & FormulaString

        Set iRng = Range(rng.Cells(iRow, 1), rng.Cells(iRow, nCol))
        iRng.Select

        With Selection
            .FormatConditions.Delete

'THIS IS WHERE THE PROBLEM IS, NEED TO MAKE A FUNCTION OR STRING THAT INCREMENTS BASED ON THE PROJECT ROW BUT IT STOP AFTER THE FIRST GROUP

            '.FormatConditions.Add Type:=xlExpression, Formula1:="=IdentifyFormulaCells(I34)"

            .FormatConditions.Add Type:=xlExpression, Formula1:=FormulaString

        End With

        MsgBox "project row before step= " & ProjectRow
        ProjectRow = ProjectRow + iStep
        FormulaString = "=IdentifyFormulaCells(I" & CStr(ProjectRow) & ")"

    Next iRow

End Sub

如果我注释掉

.FormatConditions.Add..

行，则代码在每组31行中循环运行，但由于代码现在处于静止状态，它在仅输入第34行的条件格式后停止

---

为什么只输入第一行？

如果目标只是识别包含公式的单元格，那么可能更容易：

主页>编辑>查找和选择-转到特殊…，公式并将所选格式应用于所选单元格