Created
March 13, 2015 08:34
-
-
Save diskostu/e4d8721170d39f9e5027 to your computer and use it in GitHub Desktop.
Set an alternating background for Excel rows based on the data in a certain column (in this example: cloumn 2 (B))
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Sub Faerbe_RGB() | |
| 'Makro von PauleVBA @ gutefrage.net | |
| Dim lngGrau As Long 'RGB-Wert fuer Grau | |
| Dim lngWeiss As Long 'RGB-Wert für weiss | |
| Dim lngEnde As Long 'Ende der gefuellten Zeilen | |
| Dim lngInterneFarbe As Long 'die gewuenschte Fuellung | |
| Dim I As Long ' einfach Zaehlvariable | |
| lngGrau = RGB(235, 235, 235) 'Farbe Grau definieren | |
| lngWeiss = RGB(255, 255, 255) 'Farbe weiss definieren | |
| lngEnde = Range("B:B").SpecialCells(xlCellTypeLastCell).Row | |
| lngInterneFarbe = lngWeiss ' festsetzen, welche Farbe die Ueberschrift hat | |
| ' die andere Farbe wird dann automatisch für die erste Zeile genommen | |
| For I = 2 To lngEnde 'von Zeile 5 bis zur letzten genutzten | |
| If Cells(I, 2) <> Cells(I - 1, 2) Then 'Zellinhalte vergleichen | |
| 'Farbwechsel | |
| If lngInterneFarbe = lngGrau Then | |
| 'wenn bisher Grau, dann weiss | |
| lngInterneFarbe = lngWeiss | |
| Else | |
| 'wenn bisher weiss, dann grau | |
| lngInterneFarbe = lngGrau | |
| End If | |
| End If | |
| 'die Zeile faerben | |
| Rows(I).Interior.Color = lngInterneFarbe | |
| Next I | |
| End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment