Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
18.04.2024 18:04:29
Formel fehler Wert#
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
160to164
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
160to164
160to164
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Zeilenmarkierung

Zeilenmarkierung
20.09.2002 08:40:49
Josef
Guten Morgen!

Ich habe in einem Arbeitsblatt z.B. ca. 2000 Datensätze.
In Spalte E stehen Familiennamen.Z.B. 7x Huber, 10x Muster, 15x Müller usw.
Ich möchte nun, wenn die Tabelle z.B. nach die Familiennamen sortiert ist, die ganze Zeile vom Huber blau , die von Muster gelb und die von Müller wieder blau usw. markieren.
Gäbe es hier über VBa eine Möglichkeit?
Für eine eventuelle Hilfe wäre ich dankbar.

Josef

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: Zeilenmarkierung
20.09.2002 09:03:30
beckersbest
Hallo Josef,

versuch's doch mal hiermit:

Sub farben()
Dim farbe
Dim zeile As Integer
zeile = 2
farbe = 40

While Not Cells(zeile, 1) = ""
If Cells(zeile, 1) = Cells(zeile - 1, 1) Then
Cells(zeile, 1).Interior.ColorIndex = farbe
Else
If farbe = 40 Then
farbe = 37
Else
farbe = 40
End If
Cells(zeile, 1).Interior.ColorIndex = farbe
End If
zeile = zeile + 1
Wend
End Sub


Gruß
Thorsten

Re: Zeilenmarkierung
20.09.2002 09:13:53
Josef
Hallo Thorsten!
Danke,es würde klappen.

Nur wird z.B. Müller1 blau gefärbt, Müller2 braun gefärbt, Müller3 wieder blau gefärbt.
Wenn, dann sollte Müller generell blau gefärbt sein, Muster generell braun gefärbt sein usw.
Vor allem müßte die gesamte Zeile eingefärbt sein.

Danke

Josef

Anzeige
Re: Zeilenmarkierung
20.09.2002 09:21:00
Monika
Hallo Josef,
hier meine Lösung:

Sub zeilenfärben()
Dim farbe As Integer
Dim zelle As Range
Dim name As String
farbe = 6
For Each zelle In Range(Cells(1, 5), Range("E1").End(xlDown))
If zelle <> name Then
name = zelle
If farbe = 5 Then farbe = 6 Else farbe = 5
End If
With Rows(zelle.Row).Interior
.ColorIndex = farbe
End With
Next
End Sub

Re: Zeilenmarkierung
20.09.2002 09:36:22
Josef
Hallo Monika!

Das war es.
Ich hätte nur noch eine Bitte.
Wenn es jetzt z.b.10x den Müller gibt, aber 2 Müller Gerhard, 3x Müller Anton und 5x Müller Susanne, könnte man das ganze dann noch irgenwie differenzieren.Die Vornamen wären in der Spalte rechts vom Familiennamen.


Auf jeden Fall besten Dank für Deine großartige Unterstützung


Josef

Anzeige
Re: Zeilenmarkierung
20.09.2002 09:43:08
beckersbest
Hier noch einmal so, dass jeder Name eine eigene Farbe bekommt:


Sub farben()
Dim farbe
Dim zeile, i As Integer
zeile = 2
farbe = 1


While Not Cells(zeile, 1) = ""
zaehler = 0
For i = 1 To zeile - 1 'Prüfen, ob Name schon einmal vorkommt
If Cells(zeile, 1) = Cells(i, 1) Then
farbe2 = Cells(i, 1).Interior.ColorIndex
zaehler = 1
End If
Next i
If Cells(zeile, 1) = Cells(zeile - 1, 1) Then
Rows(zeile).Interior.ColorIndex = Cells(zeile - 1, 1).Interior.ColorIndex
ElseIf zaehler = 1 Then
Rows(zeile).Interior.ColorIndex = farbe2
Else
farbe = farbe + 1
Rows(zeile).Interior.ColorIndex = farbe
End If
zeile = zeile + 1
Wend
If farbe = 52 Then 'Wenn Farbskala zu Ende
farbe = 1
End If

End Sub

Gruß
Thorsten

Anzeige
Re: Zeilenmarkierung
20.09.2002 09:53:12
Monika
Hallo Josef,

wenn ich Dich richtig verstanden habe, müßte es so gehen:
(Du mußt nur zwei Zeilen ändern)

Sub zeilenfärben()
Dim farbe As Integer
Dim zelle As Range
Dim name As String
farbe = 6
For Each zelle In Range(Cells(1, 5), Range("E1").End(xlDown))
If zelle & zelle.Offset(0, 1) <> name Then
name = zelle & zelle.Offset(0, 1)
If farbe = 5 Then farbe = 6 Else farbe = 5
End If
Rows(zelle.Row).Interior.ColorIndex = farbe
Next
End Sub



Re: Zeilenmarkierung
20.09.2002 09:53:40
Josef
Hallo Thorsten!

Danke für Deine Antwort.

Leider erhalte ich die Fehlermeldung
"Die ColorIndex-Eigenschaft des Interior-Objektes kann nicht festgelegt werden"

Markiert wird
"Rows(zeile).Interior.ColorIndex = farbe"


Josef

Anzeige
Re: Zeilenmarkierung
20.09.2002 09:59:44
beckersbest
Hallo Josef,

bei mir läuft das Makro einwandfrei, hast Du eventuell eine andere Excel-Version? Ich hab nämlich eigentlich auch Office 97, deutsche Version. Ansonsten kann ich mir das Problem nicht erklären.
Ich könnte Dir meine Beispieldatei ansonsten wohl zuschicken.

Gruß
Thorsten

DANKE
20.09.2002 10:04:59
Josef
Hallo Monika!

Besten Dank, das war die Lösung.

Ich wünsche Dir noch ein wunderschönes Wochenende

Josef

Re: Zeilenmarkierung
20.09.2002 10:05:10
beckersbest
Solltest Du es zum Laufen bringen, wäre es auch kein Problem, z.B. den Vornamen in die Abfrage einzubeziehen. Dann müsste die If-Abfrage folgendermaßen erweitert werden:

Sub farben()
Dim farbe
Dim zeile, i As Integer
zeile = 2
farbe = 1

While Not Cells(zeile, 1) = ""
zaehler = 0
For i = 1 To zeile - 1 'Prüfen, ob Name schon einmal vorkommt
If Cells(zeile, 1) = Cells(i, 1) And Cells(zeile, 2) = Cells(i, 2) Then
farbe2 = Cells(i, 1).Interior.ColorIndex
zaehler = 1
End If
Next i
If Cells(zeile, 1) = Cells(zeile - 1, 1) And Cells(zeile, 2) = Cells(zeile - 1, 2) Then
Rows(zeile).Interior.ColorIndex = Cells(zeile - 1, 1).Interior.ColorIndex
ElseIf zaehler = 1 Then
Rows(zeile).Interior.ColorIndex = farbe2
Else
farbe = farbe + 1
Rows(zeile).Interior.ColorIndex = farbe
End If
zeile = zeile + 1
Wend
If farbe = 52 Then 'Wenn Farbskala zu Ende
farbe = 1
End If

End Sub


Gruß
Thorsten

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige