如果符合条件，Excel VBA冻结双循环可为特定范围着色

你好

我还是VBA新手，但我几乎用我所有的脑细胞构建了下面的代码。
然而，当我执行宏时，Excel似乎工作了很长时间，但却一事无成。我没有收到任何错误消息，但Excel似乎陷入了无休止的循环。
我怀疑我的代码中的某个地方存在重大缺陷，但我似乎不知道在哪里

Sub Makro_color_cells()
Application.ScreenUpdating = False

Dim groupfrom As Range
Dim groupto As Range
Dim groupfinal As Range

lastrow = Cells(Rows.Count, "B").End(xlUp).Row
x = 4
t = 0

Do While x < lastrow

    Set groupfrom = Cells(x - 1, "F")

    Cells(x - 1, "B").Activate
    Do While ActiveCell = ActiveCell.Offset(1, 0)
       t = t + 1
       ActiveCell.Offset(1, 0).Activate
    Loop

    x = x + t
    Set groupto = Cells(x - 1, "F")
    Set groupfinal = Range(groupfrom, groupto)

    If Not (groupfinal.Find("Storage") Is Nothing) Then
    Range("groupfinal").Interior.ColorIndex = 3
    End If

    t = 0
    Set groupfrom = Nothing
    Set groupto = Nothing
    Set groupfinal = Nothing

Loop

Application.ScreenUpdating = True
End Sub

Sub Makro_color_cells（）
Application.ScreenUpdating=False
将组从As范围中调暗
Dim groupto As范围
Dim groupfinal As范围
lastrow=单元格（Rows.Count，“B”）。结束（xlUp）。行
x=4
t=0
当x

代码的目的是根据一些标准为F列中的某些单元格着色：
B列包含数字，重复项相邻放置。将列B中相同值的所有行视为“组”。 现在，如果一个“组”中的一行或多行的F列中有文本“Storage”，那么该“组”中的所有行的F列都应该着色

我的代码背后的基本思想是定位“组”，并使用

groupfrom

和

groupto

将范围

groupfinal

设置为等于F列中组的单元格。
然后使用

range.find

方法测试是否出现“存储”

我尝试了故障排除，但没有成功。
你知道为什么代码不起作用吗

我感谢任何帮助，我愿意接受不同于我的代码的想法。

---

提前谢谢你

由于所有组都将分组在一起而不是混合，因此可以使用vba脚本检查组值，使用该值的总数来定义范围并更改F列中的单元格颜色：

Sub Makro_color_cells()

Dim LastRow
Dim CurrentRow
Dim GroupValue
Dim GroupTotal
Dim GroupCheck

GroupValue = Range("B1").Value ' get the first value to search
CurrentRow = 1 ' Define the starting row

    With ActiveSheet ' find the last used cell in the column
        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    End With

    For x = 1 To LastRow ' start the reapat until last cell reached

        GroupTotal = Application.WorksheetFunction.CountIf(Range("B1:B" & LastRow), GroupValue) ' search for total of the group values
        GroupCheck = Application.WorksheetFunction.CountIf(Range("F" & CurrentRow & ":F" & CurrentRow + GroupTotal - 1), "Storage") ' search for "Storage" in the range from current row to total rows of the same group values

        If GroupCheck >= 1 Then ' if the "Storage" search is equal to one or more then colour the range of cells
            Range("F" & CurrentRow & ":F" & CurrentRow & ":F" & CurrentRow + GroupTotal - 1).Interior.ColorIndex = 3
        End If

        CurrentRow = CurrentRow + GroupTotal ' We know how many cells are in the same group so we can bypass them and move the current row to the next group of values
        GroupValue = Range("B" & CurrentRow).Value ' Get the value for the new group

        If GroupValue = "" Then ' Check the new group value and if it is nothing then we can exit the 'For Next x'
            Exit For
        End If

    Next x

End Sub

---

您的第一个定义

t

在哪里？您还可以使用

Debug.Print

获得控制台行输出，这将更容易调试。当ActiveCell…循环尝试完成时，您的

做什么？肯定有比这更好的方法。你应该避免
。在你的代码中选择
和
。激活
-它们几乎总是不必要的，只是会减慢处理速度。@Morpheus你是对的-缺少第一个定义
t
。我现在编辑了这篇文章，但问题仍然是一样的。不幸的是，@FreeMan我完全同意——肯定有比这更好的方法。其思想是在
Do While x
循环中有一个循环，用于计算“组”中的单元数，并将该数添加到
x
。此计数器是变量
t
。两个问题：您的数据是否按列下的分组排序？例如：1,1,1,4,4,5,5,6,7,7或混合列：1,7,1,4,5,5,1,6,4,7,5。如果它是按组排序的，那么这将是直接的，如果不是，行可以按组排序吗？这工作非常完美，而且速度很快！在解释每一行代码时也做得很好，这对理解代码有很大帮助！为了让我确定：本质上不是像我一样使用循环来计算组中的单元数，而是使用CountIf函数？非常感谢——如果可以的话，我会投两次票；）是，countif函数用于确定包含相同值（组）的行数，然后检查“存储”。组中某个值的总数用于查找下一组数据，有助于加快处理过程完美：）是的，使用相同值的数量查找下一组是明智的。我试着用我的第二个循环做这件事，并使用
t
作为计数器，但这是一种更有效的方法。谢谢你的帮助：）JoeBerg，我确实看了你的代码，但是没有完全弄明白，这就是为什么我写了一些新代码。我总是试图评论我的代码，即使它只是为了我自己，因为毫无疑问，如果我以后再回到它，它将帮助我。另外，我喜欢在声明变量时使用描述性名称，因为在阅读代码时，它会更有意义，就像您在原始代码中所做的那样，但是您没有声明x和t，所以这很混乱。其他程序员对此表示不满，因为这确实会使代码变长，但这是个人偏好，可能会对更大的代码产生不同。