Clever-Excel-Forum

Hallo Leute!

Wie bekomme ich farbige Textwerte aus Spalte A in einer Listbox aufgelistet?
Ich möchte ereichen das der Code in Spalte A als erstes alle werte die die Textfarbe Rot haben nacheinander auflistet,
wenn dann noch welche gelb sind die dann darunter auflistet und alle anderen danach.
Habe auch zwei Code`s gefunden bekomme aber immer FEHLER!
Bei diesen Code sagt er mir
Objektvariable oder With-Blockvariable nicht fetgelegt

Code:
Sub colorC()

  Dim rng As Range

lz = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row

For Each c In Range("A2:A" & lz).Cells

r = c.Row

        If c.Font.ColorIndex = 3 Then   'Cells(r, 2) = "N" 'rot

        UserForm5.ListBox1.AddItem rng.Value

        UserForm5.ListBox1.List(ListBox1.ListCount - 1, 1) = rng.Offset(0, 1).Value

        UserForm5.ListBox1.List(ListBox1.ListCount - 1, 2) = rng.Offset(0, 2).Value

        UserForm5.ListBox1.List(ListBox1.ListCount - 1, 3) = rng.Row

        'If c.Font.ColorIndex = 6 Then Cells(r, 2) = "Ä" 'gelb

    End if

Next

End Sub

Bei diesen:
Objekt erforderlich

Code:
Sub suchen()

  Dim rng As Range

  Dim strFirst As String

 ListBox1.Clear

  With Sheets("Daten")

    Set rng = .Range("A2:A" & .Rows.count).Find(What:=Font.ColorIndex = 3, LookIn:=xlValues, _

      LookAt:=xlWhole, MatchCase:=False, after:=.Cells(.Rows.count, 1))

    If Not rng Is Nothing Then

      strFirst = rng.Address

      Do

        UserForm5.ListBox1.AddItem rng.Value

        UserForm5.ListBox1.List(ListBox1.ListCount - 1, 1) = rng.Offset(0, 1).Value

        UserForm5.ListBox1.List(ListBox1.ListCount - 1, 2) = rng.Offset(0, 2).Value

        UserForm5.ListBox1.List(ListBox1.ListCount - 1, 3) = rng.Row

        Set rng = Sheets("Daten").Range("A2:A" & .Rows.count).FindNext(rng)

      Loop While Not rng Is Nothing And strFirst <> rng.Address

    End If

  End With

  Set rng = Nothing

End Sub

Der Code wird mit CommandButton1 gestartet

Ich weiß das man die werte nicht mit unterschiedlichen Farben in einer ListBox darstellen kann

Kann mir einer weiter helfen?
Suche schon seit Tagen nach einer Lösung.

Hallo Michael,

deine Variable rng hat in der Sub colorC keine Wertzuweisung und ist somit Nothing (Initialwert einer Rangevariablen).

Hallo!
Danke für die schnelle Hilfe!
Habe aber keine Ahnung wovon sprichst (stehe grade im Wald und sehe dei Bäume nicht)!

Kannst du mir das mal einfügen?

Danke!

Hallo Michael,

dann kommentiere ich die entsprechenden Stellen in deinem Code.

Code:
Sub colorC()

  Dim rng As Range  '<-------- hier wird die Variable rng as Range deklariert!

lz = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row

For Each c In Range("A2:A" & lz).Cells

r = c.Row

        If c.Font.ColorIndex = 3 Then 'Cells(r, 2) = "N" 'rot

        'UserForm5.ListBox1.AddItem rng.Value  '<-------- siehst du zwischen der Deklaration  und dieser Zeile irgendeine Zuweisung an rng? 

        UserForm5.ListBox1.AddItem c.Value  '<-------- und so dürfte es zumindest keine Fehlermeldung mehr geben 

        UserForm5.ListBox1.List(ListBox1.ListCount - 1, 1) = c.Offset(0, 1).Value

        UserForm5.ListBox1.List(ListBox1.ListCount - 1, 2) = c.Offset(0, 2).Value

        UserForm5.ListBox1.List(ListBox1.ListCount - 1, 3) = c.Row

End If

        'If c.Font.ColorIndex = 6 Then Cells(r, 2) = "Ä" 'gelb

    Next

End Sub

Hallo!

Vielen Dank für die Hilfe ( jezt sehe ich die Bäume wieder)

Habe noch eine frage!
Wie kann man den Code zusammen schrunpfen und vieleicht das keine leeren Zellen eingelesen werden?

Code:
Sub colorC()

  Dim rng As Range

lz = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row

For Each c In Range("A2:A" & lz).Cells      '

r = c.Row

        If c.Font.ColorIndex = 3 Then    'rot

            UserForm5.ListBox1.AddItem c.Cells.Value

        End If

    Next

For Each c In Range("A2:A" & lz).Cells

r = c.Row

        If c.Font.ColorIndex = 6 Then    'gelb

            UserForm5.ListBox1.AddItem c.Cells.Value

        End If

    Next

For Each c In Range("A2:A" & lz).Cells

r = c.Row

        If c.Font.ColorIndex = 14 Then    'grün

            UserForm5.ListBox1.AddItem c.Cells.Value

        End If

    Next

For Each c In Range("A2:A" & lz).Cells

r = c.Row

        If c.Font.ColorIndex = 1 Then     'schwarz

            UserForm5.ListBox1.AddItem c.Cells.Value

        End If

    Next

 For Each c In Range("A2:A" & lz).Cells

r = c.Row

        If c.Font.ColorIndex = -4105 Then     'schwarz

            UserForm5.ListBox1.AddItem c.Cells.Value

        End If

    Next

End Sub

Danke schon mal im vorraus

Hallo,

mit verschachtelten Schleifen geht das und du musst prüfen, ob die Zelle leer ist.

PHP-Code:
Sub colorC()
   Dim lz As Long, lngC As Long
   Dim c As Range
   Dim vntFarben As Variant
   
   vntFarben = Array(3, 6, 14, 1, -4105)
   lz = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
   For lngC = 0 To UBound(vntFarben)
      For Each c In Range("A2:A" & lz).Cells      
         If c.Font.ColorIndex = vntFarben(lngC) Then
            If Not IsEmpty(c.Value) Then Userform5.Listbox1.AddItem c.Value
         End If
      Next c
   Next lngC

End Sub 

Oder

Code:
Sub M_snb()

    For Each ar In Columns(1).SpecialCells(2).Areas

       c00 = c00 & vbCr & Join(Application.Transpose(ar), vbCr)

    Next

    listbox1.List = Split(Mid(c00, 2), vbCr)

End Sub

Hallo!

Danke für die Hilfe.

michel34497

Steffl

michel34497

Steffl

michel34497

Steffl

snb

michel34497