Question

我想修改下面的VBA代码，这样如果宏覆盖了一个单元格，那么它将被突出显示，以便我们可以返回并检查它。例如：如果我们在“汽车”这个词之前有“纸板”这个词，程序会用纸板的答案覆盖纸板的答案，因为它有相同的字母所以它出现在我们的过滤器中，我希望这个单元格是突出显示，以便我们知道它改变了答案。

非常感谢你的帮助！

Sub filter()

Dim i As Integer
Dim lastrow As Long
Dim rng As Range
Dim lastrows As Long
Dim rngs As Range

Application.ScreenUpdating = False

Set rng = Sheets("Sheet2").Cells
Set rngs = Sheets("Sheet1").Cells

lastrow = rng.Find(what:="*", after:=rng.Cells(1), lookat:=xlPart, 
LookIn:=xlFormulas, Searchorder:=xlByRows, searchdirection:=xlPrevious, 
MatchCase:=False).Row
lastrows = rngs.Find(what:="*", after:=rngs.Cells(1), lookat:=xlPart, 
LookIn:=xlFormulas, Searchorder:=xlByRows, searchdirection:=xlPrevious, 
MatchCase:=False).Row

If (Sheets("Sheet2").AutoFilterMode And Sheets("Sheet2").FilterMode) Or 
Sheets("Sheet2").FilterMode Then
Sheets("Sheets2").ShowAllData
End If

For i = 3 To lastrows
searchfor = Sheets("Sheet1").Range("A" & i).Value
Category = Sheets("Sheet1").Range("B" & i).Value

Sheets("Sheet2").Range("$A$2:A" & lastrow).AutoFilter field:=1, 
Criteria1:="=*" & searchfor & "*"

With Sheets("Sheet2")
    headerrow = .AutoFilter.Range(1).Row
    lastfilterrow = .Range(Split(.AutoFilter.Range.Address, ":")(1)).Row
    getfilteredrangetoprow = .Range(.Rows(headerrow + 1), 
.Rows(Rows.Count)).SpecialCells(xlCellTypeVisible)(1).Row
    If getfilteredrangetoprow = lastfilterrow + 1 Then 
getfilteredrangetoprow = 0
End With

If getfilteredrangetoprow <> 0 Then
    For Each Cell In Sheets("Sheet2").Range("b3:b" & 
lastrow).SpecialCells(xlCellTypeVisible)
        Cell.FormulaR1C1 = Category
    Next Cell
    End If

Next i

If (Sheets("Sheet2").AutoFilterMode And Sheets("sheet2").FilterMode) Or 
Sheets("sheet2").FilterMode Then
Sheets("Sheet2").ShowAllData
End If



End Sub

Answer 1

您可以在

中找到几种突出显示单元格的方法

http://www.excel-easy.com/vba/examples/highlight-active-cell.html

Cells.Interior.ColorIndex = 0

Cells(i, columnNumberValue).Interior.ColorIndex = 37

修改宏以突出显示覆盖的单元格

1 个答案: