Question

我遇到了一个问题，希望有人可以帮助我解决。我正在尝试在W列中搜索文本“ EB”，“ ER”和/或“ LR”的所有实例。然后突出显示整行。下面是代码，但由于范围不断出现'withsheets（“ sheet1”）。rng`的调试错误，我遇到了范围问题。调试错误是“对象不支持此属性或方法。不确定我在这里错了，但是任何帮助将不胜感激！

谢谢！

Sub HighlightCells()

Dim c As Range, FoundCells As Range
Dim firstaddress As String
Dim lrow As Long, rng As Range, cell As Range

lrow = Cells(Cells.Rows.Count, "W").End(xlUp).Row
Set rng = Range("W2:W" & lrow)

   Application.ScreenUpdating = False
With Sheets("Sheet1").rng
Set c = .Cells.Find(What:="EB", After:=.Cells(Rows.Count, 1), LookIn:=xlValues, LookAt:= _
xlPart, MatchCase:=False)

Set c = .Cells.Find(What:="LR", After:=.Cells(Rows.Count, 1), LookIn:=xlValues, LookAt:= _
xlPart, MatchCase:=False)

Set c = .Cells.Find(What:="ER", After:=.Cells(Rows.Count, 1), LookIn:=xlValues, LookAt:= _
xlPart, MatchCase:=False)
If Not c Is Nothing Then
    firstaddress = c.Address
    Do
        If FoundCells Is Nothing Then
            Set FoundCells = c
        Else
            Set FoundCells = Union(c, FoundCells)
        End If

        Set c = .Cells.FindNext(c)
    Loop While Not c Is Nothing And firstaddress <> c.Address
    FoundCells.Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 65535
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
Else
    MsgBox "No DRC found."
End If
End With
Application.ScreenUpdating = True

End Sub

VBA代码帮助，出现范围问题

0 个答案: