查找列標題並突出顯示它，包括其下面的單元格

Question

Private Sub CommandButton2_Click()
Dim headersRange As Range, cellsToloop As Range
Dim col As Long, lRow As Long, colName As String

Set headersRange = Range("HeadersToFind")

For Each cellsToloop In headersRange 'This line works
  If cellsToloop.Value = "Sun" Then 'This line works
    cellsToloop.Cells.Interior.Color = RGB(160, 160, 100) ' up to here

    'From here it does nothing
    col = cellsToloop.Column
    colName = Split(col.Cells(, col).Address, "$")(1)
    lRow = .Range(colName & .Rows.Count).End(xlUp).Row
    Set rng = .Range(colName & "8:" & colName & lRow)
    rng.Cells.Interior.Color = RGB(160, 160, 200)
    'Upt her doesnt work
  End If
Next cell
End Sub

使用此代碼，我設法突出顯示標題，但是我未能突出顯示每個列標題Sun下的單元格。

Answer 1

如果您的代碼沒有引發任何錯誤，那么您的Excel / VBE肯定有問題。

它應該在以下位置拋出錯誤：

colName = Split(col.Cells(, col).Address, "$")(1)因為col聲明為long，因此應該沒有.cells屬性。

lRow = .Range(colName & .Rows.Count).End(xlUp).Row Set rng = .Range(colName & "8:" & colName & lRow)因為要使用.Range您需要一個With子句。

---

這應該是用顏色填充所有“ Sun列的正確代碼。

Sub test()

    Dim headersRange As Range, cellsToloop As Range
    Dim rngFind As Range


    '/ Sheet1 is just an example name.
    Set headersRange = Sheet1.Range("HeadersToFind")

    '/ To Fill upto a specific value in a cell
    Set rngFind = Sheet1.Cells.Find("Total", , , xlWhole)

    For Each cellsToloop In headersRange
        If cellsToloop.Value = "Sun" Then
            '/ Fill all the way to last cell
            Sheet1.Range(cellsToloop, cellsToloop.End(xlDown)).Interior.Color = RGB(160, 160, 200)

            '/ Fill all they way upto usedrange's lastrow.
            cellsToloop.Resize(Sheet1.UsedRange.Rows.Count, 1).Interior.Color = RGB(160, 160, 200)

            '/ To Fill upto a specific value in a cell
            If Not rngFind Is Nothing Then
             cellsToloop.Resize(rngFind.Row, 1).Interior.Color = RGB(160, 160, 200)
            End If

        End If
    Next

End Sub

Answer 2

你可以這樣走

Option Explicit

Private Sub CommandButton2_Click()
    Dim headersRange As Range, totalCell As Range, sunCell As Range
    Dim firstAddress As String

    Set headersRange = Range("HeadersToFind")

    With headersRange
        Set totalCell = .Cells(1).End(xlDown).Offset(-1)
        Set sunCell = .Find("Sun", , xlValues, xlWhole)
        If Not sunCell Is Nothing Then
            firstAddress = sunCell.Address
            Do
                .Parent.Range(sunCell, .Parent.Cells(totalCell.Row, sunCell.Column)).Interior.Color = RGB(160, 160, 200)
                Set sunCell = .FindNext(sunCell)
            Loop While sunCell.Address <> firstAddress
        End If
    End With
End Sub

我假設：

• 宏運行時表始終為空

• “ total”始終在headersRange第一欄中

如果不正確，則可以輕松修改代碼