使用VBA基于文本匹配突出显示行和列的相交单元格

Question

我正在尝试使用VBA，当列标题中的文本与行中的文本相同时，该行和列的相交单元会以某种颜色突出显示。

示例：我尝试使用以下代码，但未提供所需的输出

Sub cellintersection()
Application.EnableEvents = False
    Application.ScreenUpdating = False

    Dim ws As Worksheet
    Set ws = ActiveSheet

    Dim cols As Range, rws As Range
    Dim lastRow As Integer: lastRow = ws.UsedRange.Rows.Count
    Dim lastColumn As Integer: lastColumn = ws.UsedRange.Columns.Count

    For Each cols In ws.Range(ws.Cells(1, 1), ws.Cells(1, lastColumn))
        If (Not (cols.Value = vbNullString)) Then
            For Each rws In ws.Range("A1:A" & lastRow)
                If (rws.Value = cols.Value) Then ws.Cells(rws.Row, cols.Column).Interior.Color = 5296210
            Next
        End If
    Next

    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

必需的输出：通过将文本与蓝色匹配来使绿色的单元格

。

Answer 1

因此，根据我的评论使用条件格式：

• 选择范围B4:D6

• 开始>条件格式>新规则>公式：

  =B$2=$A4
  

• 选择填充颜色并确认

请注意，通过VBA填充单元是静态的，而条件格式是动态的，并且会根据对数据的更改而改变。

Answer 2

我修复了一些发现的错误：

Sub cellintersection()
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim ws As Worksheet
Set ws = ActiveSheet

Dim cols As Range, rws As Range
Dim lastRow As Integer: lastRow = ws.UsedRange.Rows.Count
Dim lastColumn As Integer: lastColumn = ws.UsedRange.Columns.Count

For Each cols In ws.Range(ws.Cells(2, 1), ws.Cells(2, lastColumn))
    If cols.Value <> vbNullString Then
        For Each rws In ws.Range("A1:A" & lastRow)
            If rws.Value = cols.Value Then ws.Cells(rws.Row, cols.Column).Interior.Color = 5296210
        Next
    End If
Next

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

启动第一个For ... Each循环时，您正在浏览第1行，该行中没有任何值。标头位于第2行。另外，某些If语句不必要地复杂，例如

If (Not (cols.Value = vbNullString)) Then

与

相同

If cols.Value <> vbNullString Then