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

Question

我正在尝试使用 VBA，当列中的文本 header 与行中的文本相同时，行和列的交叉单元格会突出显示一些颜色.

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

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

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

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 行，其中没有任何值。您的 headers 在第 2 行。您的一些 If 语句也不必要地复杂，例如

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

与

相同

If cols.Value <> vbNullString Then

Answer 2

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

Select 范围 B4:D6
开始>条件格式>新建规则>公式：
```
=B=$A4
```
选择填充颜色并确认

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

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

Highlight intersection cell of row and column based on Text matching using VBA

excel

vba

conditional-formatting