[英]selecting multiple different ranges in a loop VBA
我是 VBA 新手,我正在尝试制作一个宏,它在 C 列中搜索找到所有包含“teston”的单元格,然后找到它下面包含“testoff”的单元格,并在列中突出显示它们之间的所有单元格在它的旁边。 有多个 teston 实例 to testoff。
此代码有效,但仅突出显示 teston 的第一个实例 to 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"
不要单独寻找它们。 只需遍历整个列,它们就会被自己找到。
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
试试这个 - 假设每个 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
这应该会提高速度
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.