excel 加速范围内的if循环- vba

deyfvvtc 于 2023-08-08 发布在其他

关注(0)|答案(3)|浏览(118)

我需要VBA代码，将颜色的文本条件时，满足一个单元格。现在我的代码效率不高，可能是因为循环搜索的列E的整个范围。问题是，在E列中，我总是有一个不同范围的已使用单元格。你能帮我加速代码吗？

Sub color_status()
   Dim cell As Range
   
   For Each cell In Range("E:E")
      If cell.value = "Open" Then
         cell.Interior.Color = RGB(198, 224, 180)
      ElseIf cell.value = "In Progress" Then
         cell.Interior.Color = RGB(169, 208, 142)
      ElseIf cell.value = "Done" Then
         cell.Interior.Color = RGB(112, 173, 71)
      ElseIf cell.value = "On Hold" Then
         cell.Interior.Color = RGB(226, 239, 218)
      End If
   Next cell
End Sub

字符串

excel

来源：https://stackoverflow.com/questions/76761995/speed-up-if-loop-in-a-range-vba

3条答案

按热度按时间

7fyelxc51#

使用Intersect

Sub color_status()

    Dim rng As Range, cel As Range, s As String, dict As Object
    Dim t0 As Single: t0 = Timer
    
    Set dict = CreateObject("Scripting.Dictionary")
    With dict
        .Add "Open", RGB(198, 224, 180)
        .Add "In Progress", RGB(169, 208, 142)
        .Add "Done", RGB(112, 173, 71)
        .Add "On Hold", RGB(226, 239, 218)
    End With
    
    With ActiveSheet
        Set rng = Application.Intersect(.UsedRange, .Range("E:E"))
    End With

    If rng Is Nothing Then
        MsgBox "No data", vbExclamation
        Exit Sub
    Else
        For Each cel In rng
            s = Trim(cel.Value)
            If dict.exists(s) Then
                cel.Interior.Color = dict(s)
            End If
        Next
    End If

    MsgBox rng.Rows.Count & " rows scanned", _
           vbInformation, Format(Timer - t0, "0.0 secs")
End Sub

字符串

赞(0）回复(0）举报 2023-08-08

nuypyhwy2#

Range（“E：E：）太大，无法循环-它大约有100万个像元
1 variant使用UsedRange限制它，并通过索引循环：

Dim Ecount as Long, i as Long
    Ecount=ActiveSheet.UsedRange.Rows.count
    
    For i=1 to Ecount
if Cells(i,5)= "Open" Then
    '(etc. your code inside the loop)
    Next i

字符串
或2种变体

Dim lRange as Range
lRange=Range(Cells(1,5),Cells(ActiveSheet.UsedRange.Rows.count,5))
'then loop as you do with the lRange
For each cell in lRange
        '(etc. your code inside the loop)
Next cell

型
对我来说，使用单元格索引循环是调试更容易的-当你调试时，你立即知道行号

赞(0）回复(0）举报 2023-08-08

rmbxnbpk3#

我已经根据您提供的值创建了一个Excel文件，但我使用了条件格式。这就是结果：
x1c 0d1x的数据
由于它不是使用VBA完成的，因此性能是即时的，但我想知道您的RGB值是否正确：-）

赞(0）回复(0）举报 2023-08-08