[英]Find text and change color
我想循環工作簿的所有工作表,更改其中包含特定字符串的單元格的顏色。
我使用.Replace
(我需要MatchCase 和lookat)。
它在不考慮大小寫的情況下替換文本。 (例如,如果在數組中它是小寫的並且找到的字符串是大寫的,它將被更改為小寫)。 繞過這個的唯一方法是使用MatchCase:= false
並列出所有選項,這可能非常低效。
我可以使用.Find
或其他函數執行操作嗎?
Sub CellMarked()
Dim fndlist As Variant, x As Integer, sht as worksheet
fndlist = Array("Column1", "Column2")
For Each sht In ActiveWorkbook.Worksheets
With sht
For x = LBound(fndlist) To UBound(fndlist)
.Cells.Replace What:=fndlist(x), Replacement:=fndlist(x), _
lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, _
SearchFormat:=False, ReplaceFormat:=True
Application.ReplaceFormat.Font.Color = 255
Next x
End With
next sht
End Sub
您可以使用Find()
方法並構建一個輔助函數:
Function GetCellsWithValue(sht As Worksheet, val As Variant, foundCells As Range) As Boolean
Dim found As Range
Dim firstAddress As String
With sht.UsedRange
Set foundCells = .Resize(1, 1).Offset(.Rows.Count) ' fill foundCells with a "dummy" found one to avoid 'If Not foundCells Is Nothing' check before any 'Union()' method call
Set found = .Find(what:=val, lookat:=xlPart, LookIn:=xlValues)
If Not found Is Nothing Then
firstAddress = found.Address
Do
Set foundCells = Union(foundCells, found)
Set found = .FindNext(found)
Loop While found.Address <> firstAddress
End If
Set foundCells = Intersect(.Cells, foundCells) ' get rid of the "dummy" found cell
End With
GetCellsWithValue = Not foundCells Is Nothing
End Function
您可以在“主”子中使用,如下所示:
Option Explicit
Sub CellMarked()
Dim fndlist As Variant, val As Variant, sht As Worksheet
Dim foundCells As Range
fndlist = Array("Column1", "Column2")
For Each sht In ActiveWorkbook.Worksheets
With sht
For Each val In fndlist
If GetCellsWithValue(sht, val, foundCells) Then foundCells.Font.Color = 255
Next
End With
Next sht
End Sub
Sub CellMarked()
Dim rngFind As Range, rngU As Range
Dim fndlist As Variant
Dim strFirst As String
Dim i As Integer, x As Integer
fndlist = Array("Column1", "Column2")
For i = 1 To Worksheets.Count
With Worksheets(i)
For x = 0 To UBound(fndlist)
' Check if worksheet has no values.
If Not .Cells.Find("*", .Cells(.Rows.Count, Columns.Count), -4163, 2, 1) _
Is Nothing Then
' Find string.
Set rngFind = .Cells.Find(fndlist(x), _
.Cells(.Rows.Count, Columns.Count))
If Not rngFind Is Nothing Then
If Not rngU Is Nothing Then
Set rngU = Union(rngU, rngFind) ' All other occurrences.
Else
Set rngU = rngFind ' First occurrence.
End If
strFirst = rngFind.Address
' Check for other occurrences.
Do
Set rngFind = .Cells.FindNext(rngFind)
If rngFind.Address <> strFirst Then
Set rngU = Union(rngU, rngFind)
Else
Exit Do
End If
Loop
End If
End If
Next
' Apply formatting.
If Not rngU Is Nothing Then
rngU.Interior.Color = 255
' rngU.Font.Color = 255
Set rngU = Nothing
End If
End With
Next
End Sub
更改“strToFind”並嘗試:
Option Explicit
Sub test()
Dim strToFind As String
Dim rng As Range, cell As Range
Dim ws As Worksheet
'String to Find is "Test"
strToFind = "Test"
With ThisWorkbook
For Each ws In .Worksheets
With ws
Set rng = .UsedRange
For Each cell In rng
If cell.Value = strToFind Then
cell.Interior.Color = RGB(255, 0, 0)
End If
Next cell
End With
Next ws
End With
End Sub
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.