enter image description here

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

Avec ce code, j'ai réussi à mettre en évidence les en-têtes mais je n'ai pas réussi à mettre en évidence la cellule sous chaque en-tête de colonne Sun.

0
Mdugo Trading 17 janv. 2017 à 16:57

2 réponses

Meilleure réponse

Tu pourrais aller comme ça

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

Où j'ai supposé que:

  • la table est toujours vide au moment où la macro s'exécute

  • "total" est toujours dans la headersRange première colonne

S'ils ne sont pas vrais, le code peut être facilement adapté

0
user3598756 17 janv. 2017 à 18:19

Si votre code ne génère aucune erreur, il y a certainement un problème avec votre Excel / VBE.

Cela devrait générer une erreur sur:

colName = Split(col.Cells(, col).Address, "$")(1) car col est déclaré comme long et ne doit donc pas avoir de propriété .cells.

lRow = .Range(colName & .Rows.Count).End(xlUp).Row Set rng = .Range(colName & "8:" & colName & lRow) car pour utiliser .Range, vous avez besoin d'une clause With.


Ce devrait être le bon code pour remplir toutes les colonnes Sun avec une couleur.

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
1
cyboashu 17 janv. 2017 à 14:23