VBA: Zellen einfärben

Forumthread: VBA: Zellen einfärben

13.02.2020 08:38:24

Erwin

Guten Morgen Miteinander,
ich habe viele lange Listen mit teilweise mehr als 20.000 Aktenzeichen, die manchmal einfach, aber oft auch mehrfach vorkommen (Listen sind nach Akz. sortiert).
Ich suche eine VBA Lösung, welche alle mehrfach vorkommenden Akz. abwechselnd unterschiedlich einfärbt.
Einfach vorkommende Werte sollen keine Farbfüllung erhalten.
Ein Start sollte über eine Inputbox erfolgen, da das Aktenzeichen nicht immer in der gleichen Zeile / Zelle beginnt.
Eine Beispieldatei, wie es aussehen soll, ist hier: https://www.herber.de/bbs/user/135159.xlsm
Schon mal vielen Dank für euere Mühe
Grüße Erwin

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: VBA: Zellen einfärben

13.02.2020 09:18:35

fcs
AW: VBA: Zellen einfärben

13.02.2020 09:28:37

Erwin
AW: eine Frage - eine Antwort und es passt

13.02.2020 09:56:21

fcs

AW: VBA: Zellen einfärben

13.02.2020 09:18:35

fcs

Hallo Erwin,
hier ein entsprechendes Makro
LG
Franz

Sub Faerben_mehrfache()
Dim Farbe_1 As Long, Farbe_2 As Long
Dim bolFaerben As Boolean
Dim Farbe As Long
Dim Wert_alt
Dim wks As Worksheet
Set wks = ActiveSheet
Dim zeile As Long, Spalte As Long, rngStart As Range
Farbe_1 = RGB(204, 255, 204) '13434828 - helles Grün
Farbe_2 = RGB(255, 255, 204) '13434879 - helles Gelb
Set rngStart = Application.InputBox( _
Prompt:="Bitte die Startzelle für die Markierung wählen", _
Title:="Mehrfache markieren", Default:=ActiveCell.Address, Type:=8)
zeile = rngStart.Row
Spalte = rngStart.Column
With wks
Wert_alt = wks.Cells(zeile, Spalte).Value
Farbe = Farbe_1
For zeile = rngStart.Row + 1 To .Cells(.Rows.Count, Spalte).End(xlUp).Row
If Wert_alt  .Cells(zeile, Spalte).Value Then
If bolFaerben = True Then
If Farbe = Farbe_1 Then
Farbe = Farbe_2
Else
Farbe = Farbe_1
End If
End If
Wert_alt = .Cells(zeile, Spalte).Value
bolFaerben = False
ElseIf Wert_alt = .Cells(zeile, Spalte).Value Then
If bolFaerben = False Then
'vorherige Zeile färben
.Cells(zeile - 1, Spalte).Interior.Color = Farbe
End If
.Cells(zeile, Spalte).Interior.Color = Farbe
bolFaerben = True
End If
Next
End With
Fehler:
With Err
Select Case .Number
Case 0 'alles OK
Case 424 'Objekt erforderlich
'Fehler weil Eingabe in Inputbox abgebrochen wurde
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbOKOnly, "Fehler im Makro ""Faerben mehrfache"""
End Select
End With
End Sub

AW: VBA: Zellen einfärben

13.02.2020 09:28:37

Erwin

Hallo Franz,
wie geht das, eine Frage - eine Antwort und es passt supergenau?!
Vielen herzlichen Dank für deine Mühe.
Grüße - Erwin

AW: eine Frage - eine Antwort und es passt

13.02.2020 09:56:21

fcs

Hallo Erwin,
wie geht das, eine Frage - eine Antwort und es passt supergenau?!
präzise Frage, gute Beispieldatei ----&gt präzise Antwort
:-)
LG
Franz

Beliebteste Forumthreads (12 Monate)

Forumthread: VBA: Zellen einfärben

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread