突出显示行和列VBA的交叉单元格

Question

我正在尝试记录一个宏，其中如果列标题中的文本与行中的文本相同，则行和列的交叉单元格将突出显示。

例如：

A11: "description" 
Y1: "description"
->Y11 should be highlighted

Answer 1

您的回答似乎没有直观地回答手头的问题：如何在找到的匹配项上突出显示相交的行和列？

一种天真的方法是遍历列和行以查找匹配项：

Private Sub ColorIntersection()

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
    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 2

原来如此。与我需要的完美配合（它还突出显示交叉路口前面的一些单元格）

Sub BorderForNonEmpty2()

 Dim wb As Workbook
 Dim wsCurrent As Worksheet

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

Set wb = ActiveWorkbook
Set wsCurrent = wb.ActiveSheet

Dim atLastCompareDate As Boolean
Dim atLastMPDate As Boolean
Dim mPDateCounter As Integer
Dim compareDateCounter As Integer
mPDateCounter = 3

'loop over each row where the value in column c is not empty, starting at row 3
Do While Not atLastMPDate
    Dim mPDate As String

    mPDate = wsCurrent.Range("C" + CStr(mPDateCounter)).Value
    atLastCompareDate = False
    If (mPDate = Null Or mPDate = "") Then
        atLastMPDate = True

    Else
        'loop over each column where the value in row 1 is not empty, starting at column e
        compareDateCounter = 5
        Do While (Not atLastCompareDate)
            Dim compareDate As String
            Dim currentCellColumn As String
            If (compareDateCounter <= 26) Then
                currentCellColumn = Chr((compareDateCounter) + 96)
            Else
                If (compareDateCounter > 26) And (compareDateCounter Mod 26 = 0) Then
                    currentCellColumn = Chr(Int(compareDateCounter / 26) - 1 + 96) + Chr(122)
                Else
                    currentCellColumn = Chr(Int(compareDateCounter / 26) + 96) + Chr((compareDateCounter Mod 26) + 96)
                End If
            End If
            compareDate = wsCurrent.Range(currentCellColumn + CStr(1)).Value
            If (compareDate = Null Or compareDate = "") Then
                atLastCompareDate = True
            Else
                If (compareDate = mPDate) Then
                    Dim cellLocation As String
                    If (compareDateCounter <= 26) Then
                        cellLocation = Chr((compareDateCounter) + 96)
                    Else
                        If (compareDateCounter > 26) And (compareDateCounter Mod 26 = 0) Then
                            cellLocation = Chr(Int(compareDateCounter / 26) - 1 + 96) + Chr(122)
                        Else
                            cellLocation = Chr(Int(compareDateCounter / 26) + 96) + Chr((compareDateCounter Mod 26) + 96)
                        End If
                    End If

                    wsCurrent.Range(cellLocation + CStr(mPDateCounter)).Interior.ColorIndex = 11

                    'Loop backwards to mark the 6 dates before
                    Dim i As Integer
                    i = compareDateCounter - 1
                    Do While (i > compareDateCounter - 7)
                        If (i <= 26) Then
                            cellLocation = Chr((i) + 96)
                        Else
                            If (i > 26) And (i Mod 26 = 0) Then
                                cellLocation = Chr(Int(i / 26) - 1 + 96) + Chr(122)
                            Else
                                cellLocation = Chr(Int(i / 26) + 96) + Chr((i Mod 26) + 96)
                            End If
                        End If
                        wsCurrent.Range(cellLocation + CStr(mPDateCounter)).Interior.ColorIndex = 43
                        wsCurrent.Range(cellLocation + CStr(mPDateCounter)).Borders.LineStyle = xlContinuous
                        wsCurrent.Range(cellLocation + CStr(mPDateCounter)).Borders.ColorIndex = 11

                        i = i - 1
                    Loop
                    atLastCompareDate = True
                End If
            End If
            compareDateCounter = compareDateCounter + 1
        Loop
    End If
    mPDateCounter = mPDateCounter + 1
Loop

结束子