在循环VBA中选择多个不同的范围

Question

我是 VBA 的新手，我正在尝试创建一个宏，通过 C 列搜索找到包含“teston”的所有单元格，然后找到它下方包含“testoff”的单元格并突出显示它们之间的所有单元格在它旁边的列中。有多个 teston 实例要测试。

此代码有效，但仅突出显示 teston 到 testoff 的第一个实例

    Dim findrow As Long, findrow2 As Long


    On Error GoTo errhandler


    findrow = Range("C:C").Find("teston", Range("C1")).Row
    findrow2 = Range("C:C").Find("testoff", Range("C" & findrow)).Row
    Range("F" & findrow + 1 & ":F" & findrow2 - 1).Select
        With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 16764159
                .TintAndShade = 0
                .PatternTintAndShade = 0
              End With
errhandler:
    MsgBox "No Cells containing specified text found"

这是我试图做的，以突出它们，但它没有突出任何东西

    Range("A1").Select
    Selection.End(xlDown).Select
    Dim lastcell As Long
    lastcell = ActiveCell.Row
    
    Dim findrow As Long, findrow2 As Long, I As Long, inext As Long
    
    inext = 1
    
    On Error GoTo errhandler
    
      Do While I < lastcell
              
            findrow = Range("C" & inext & ":" & "C" & lastcell).Find("test1", Range("C1")).Row
            findrow2 = Range("C" & inext & ":" & "C" & lastcell).Find("test2", Range("C" & findrow)).Row
            Range("F" & findrow + 1 & ":F" & findrow2 - 1).Select
                With Selection.Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 16764159
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                End With
            Range("findrow2").Select
            inext = ActiveCell.Row
            findrow = findrow2
                I = I + 1
       Loop
              
errhandler:
    MsgBox "No Cells containing specified text found"

Answer 1

不要单独寻找它们。只需浏览整个专栏，它们就会被自己找到。

Sub color_between_tests()
Dim tSearch As Range
Dim oCell As Range
Dim bColorOn As Boolean
    Set tSearch = Application.Intersect(ActiveSheet.UsedRange, ActiveSheet.Columns("C"))
    bColorOn = False
    For Each oCell In tSearch
        oCell.Offset(0, 3).Interior.Color = 16764159
        Select Case oCell.Text
            Case "teston"
                bColorOn = True
            Case "testoff"
                bColorOn = False
            Case Else
                If Not bColorOn Then oCell.Offset(0, 3).Interior.Pattern = xlNone
        End Select
    Next oCell
End Sub

Answer 2

试试这个 - 假设每个 teston 后面都有一个 testoff，并且没有值对的嵌套

Sub Tester()

    Dim rngSrch As Range, ws As Worksheet, allOn As Collection, c As Range, c2 As Range
    
    Set ws = ActiveSheet
    Set rngSrch = ws.Columns("C")
    
    Set allOn = FindAll(rngSrch, "teston") 'first find all the "teston"
    For Each c In allOn
        'for each one find the next "testoff"
        Set c2 = rngSrch.Find("testoff", after:=c, lookat:=xlWhole)
        If Not c2 Is Nothing Then
            If c2.Row > c.Row Then
                ws.Range(c.Offset(1, 3), c2.Offset(-1, 3)).Interior.Color = vbYellow
            Else
                Exit For 'wrapped back up - exit
            End If
        End If
    Next c
    
End Sub

'find all matches in a given range
Public Function FindAll(rng As Range, val As String) As Collection
    Dim rv As New Collection, f As Range, addr As String
    Set f = rng.Find(what:=val, after:=rng.Cells(rng.Cells.Count), _
        LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False)
    If Not f Is Nothing Then addr = f.Address()
    Do Until f Is Nothing
        rv.Add f
        Set f = rng.FindNext(after:=f)
        If f.Address() = addr Then Exit Do
    Loop
    Set FindAll = rv
End Function

Answer 3

这应该会提高速度

Dim oCell As Range
Dim R As Long
Dim Color_On As Boolean

R = Cells(Rows.Count, 3).End(xlUp).Row
Range("F1:F" & R).Interior.Pattern = xlNone
For Each oCell In Range("C1:C" & R)
    Color_On = oCell = "teston" Or Color_On
    If Color_On Then oCell.Offset(0, 3).Interior.Color = 16764159
    Color_On = Color_On And (oCell <> "testoff")
Next oCell