Hallo Holger,
 
 erstmal danke für deine Hilfe. Klappt schon einigermassen,habe nun nur ncoh ein Problem. Ich will, das der Button mit dem ich das ganze aktiviere im Blatt Namens Werte liegt, dann soll in MeineTabelle gesucht werden, dies habe ich vorher definiert und dann der Wert wieder in Werte in B67 ausgegeben werden.
 Momentan sieht mein Makro so aus.
 Ich hoffe du kannst mir noch einen letzten Abschließenden Tip geben. Bin dir echt dankbar.
 
 Sub VBMauslesen()
 'Welche Tabelle soll verwendet werden?
  MeineTabelle = Worksheets(1).Name
 
 ' Zeile
 Von = 4 'Start Teil (Zeile)
 Bis = Worksheets(MeineTabelle).UsedRange.Rows.Count
 
 Bis2 = Worksheets(MeineTabelle).UsedRange.Columns.Count
 Stat = Bis2 - 2
 
 Sheets(MeineTabelle).Activate
 
 ZelleVBM = "B67"
 VBM = 0 ' Startwert
 
 For I = 1 To Cells(Rows.Count, 16).End(xlUp).Row
 If Left(Worksheets(MeineTabelle).Range("P" & I), 2) = "TI" Then Exit For
 
 Next I
 If I > Cells(Rows.Count, 16).End(xlUp).Row Then
 MsgBox ("Kein TI gefunden!")
 Exit Sub
 End If
 Ber = InputBox("Anfangsspalte:Endspalte" + vbCrLf + vbCrLf + "Beispiel: D:AC", "Suchbereich")
 A = "abcdefghijklmnopqrstuvwxyz:"
 For I = 1 To Len(A)
 If InStr(A, Mid(LCase(Ber), I, 1)) = 0 Then
 MsgBox "Falsches Eingabeformat!"
 Exit Sub
 End If
 Next I
 j = InStr(Ber, ":")
 If j = 0 Then MsgBox "Falsches Eingabeformat!": Exit Sub
 Set r = Range(Ber)
 sc = r.Column 'erste Spalte
 ec = r.Columns.Count + r.Column - 1 'letzte Spalte
 oc = Stat 'Offenspalte
 For I = 1 To Cells(Rows.Count, oc).End(xlUp).Row
 If Cells(I, oc) = "offen" Then
 For j = sc To ec
 A = Cells(I, j).Interior.ColorIndex
 If A = 3 Or A = 50 Or A = 6 Then 'tatsächliche Farbindizees einsetzen
 B = B + 1
 Exit For 'Wenn weggelassen, werden Zellen gezählt, so Zeilen
 End If
 Next j
 End If
 Next I
 B = Worksheets("Werte").Range(ZelleVBM).Value
 
 End Sub
 
 Gruß Sabine
 
 
 
 Holger schrieb am 08.09.2008 17:56:39:
 
 Hallo sabine,
 ich gehe davon aus, dass 
 1. die Spalte mit den "offen" die drittletzte des Bereichs sein soll, der durchsucht wird. Sonst musst du die Zeile "oc = ec - 2 'Offenspalte" so anpassen, dass in oc dann die Spaltennummer steht.
 2. Zeilen, in denen die Hintergrundfarben mindestens einmal auftreten, als Ganzes und für alle Farben zusammen gezählt werden sollen. Ob die Colorindizees in Zeile "If a = 3 Or a = 4 Or a = 6 Then 'tatsächliche Farbindizees einsetzen" stimmen, musst du prüfen und ggf. anpassen. Grün könnte auch 43 sein. Du kannst eine Zelle mit der Hintergrundfarbe markieren und folgendes Makro laufenlassen, um den Index anzeigen zu lassen:
 Sub Farbindex_anzeigen()
 MsgBox Selection.Interior.ColorIndex
 End Sub
 3. das Ergebnis (Summe aller Zeilen mit entsprechenden Hintergrundfarben) in die erste freie Zelle der Spalte A ausgegeben werden soll. Ansonsten die Zeile "Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1) = b" 
 anpassen.
 Wenn du Zellen zählen willst, lässt du Zeile "Exit For 'Wenn weggelassen, werden Zellen gezählt, so Zeilen"  weg oder setzt einen Apostroph vorweg.
  
 Sub Farbenauslesen()
 For i = 1 To Cells(Rows.Count, 16).End(xlUp).Row
     If Left(Cells(i, 16), 2) = "TI" Then Exit For
 Next i
 If i > Cells(Rows.Count, 16).End(xlUp).Row Then
     MsgBox ("Kein TI gefunden!")
     Exit Sub
 End If
 Ber = InputBox("Anfangsspalte:Endspalte" + vbCrLf + vbCrLf + "Beispiel:    D:AC", "Suchbereich")
 a = "abcdefghijklmnopqrstuvwxyz:"
 For i = 1 To Len(a)
     If InStr(a, Mid(LCase(Ber), i, 1)) = 0 Then
         MsgBox "Falsches Eingabeformat!"
         Exit Sub
     End If
 Next i
 j = InStr(Ber, ":")
 If j = 0 Then MsgBox "Falsches Eingabeformat!": Exit Sub
 Set r = Range(Ber)
 sc = r.Column 'erste Spalte
 ec = r.Columns.Count + r.Column - 1 'letzte Spalte
 oc = ec - 2 'Offenspalte
 For i = 1 To Cells(Rows.Count, oc).End(xlUp).Row
     If Cells(i, oc) = "offen" Then
         For j = sc To ec
             a = Cells(i, j).Interior.ColorIndex
             If a = 3 Or a = 4 Or a = 6 Then 'tatsächliche Farbindizees einsetzen
                 b = b + 1
                 Exit For 'Wenn weggelassen, werden Zellen gezählt, so Zeilen
             End If
         Next j
     End If
 Next i
 Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1) = b
 End Sub
 
 Gruß
 Holger
 
 
 sabine schrieb am 08.09.2008 11:43:53:
 
 Hallo Holger,
 
 also:
 In Spalte 16 können verschiedene Buchstaben und Zahlenkombinationen stehen, wenn in einer die ersten beiden Buchstaben TI sind,  dann soll das Makro anfangen zu zählen.
 Dann soll das Makro in einem Bereich, durchlaufen und schauen, ob die hintergrundfarbe,gelb,rot oder grün vorhanden ist. Diesen Bereich soll man über zwei Spalten (Startspalte/Endspalte) eingeben können.
 Wenn diese Hintergrundfarbe vorhanden ist, dann sollen in der 3. letzten Spalte geprüft werden, ob nicht das Wort offen enthalten ist. Wenn etwas anderes als offen in dieser Spalte zählt, darf diese Zeile gezählt werden.
 Dies für alle benutzten Zeilen wiederholen und dann die Summe in einer Zeile ausgegeben werden.
 
 offen wird immer kleingeschrieben, TI immer groß.
 
 Ich hoffe das war jetzt verständlich.
 
 Besten Dank schon mal.
 Gruß
 Sabine
 
 
 Holger schrieb am 05.09.2008 19:47:43:
 
 Hallo Sabine,
 deine Spezifikation dessen, was dein Ziel ist, hat sich anscheinend verändert und ist noch unklarer als vorher. Ich finde es aber dennoch gut, dass du wenigstens versuchst, selbst ein Programm zu schreiben. 
 Schreibe einmal deine genauen Wünsche auf. Dabei geht es z.B. um folgende Fragen:
 Wo ist der zu durchsuchende Wertebereich? Wie wird er begrenzt?
 Soll nach der Hintergrundfarbe, der Schriftfarbe oder nach einem Text mit den Farbnamen gesucht werden?
 In welcher Spalte stehen die "offen" und befinden sich die "offen" in derselben Zeile wie der zu durchsuchende Text? Ist "offen" immer klein geschrieben?
 In welcher Zeile steht "TI"? Soll das Makro, wenn irgendwo in Spalte P "TI" steht, gar nicht erst anfangen zu zählen? Oder soll, wenn in einer Zeile "TI" steht, diese Zeile nicht mitgezählt werden? Steht nur "TI" in der Zelle/den Zellen und immer in dieser Form?
 In welchen Zellen soll für die einzelnen Farben hochgezählt werden? 
 Soll, wenn z.B. Hintergrund und Schriftfarbe beide rot sind, die entsprechende Zelle um 2 erhöht werden?
 Vielleicht kann ich dir dann weiterhelfen.
 Gruß
 Holger
 
 
 Sabine schrieb am 05.09.2008 15:30:29:
 
 Hallo Holger,
 
 erstmal danke für deine schnelle Hilfe. Ich habe mal das Makro so angepasst wie ich es brauche. Leider habe ich bei " If Cells(z.Row, Suchspalte) <> "offen" Then" ein Problem. Kannst du mir sagen, was ich falsch gemacht habe.
 Dieses Makro darf nur anfangen zu zählen wenn es vorher in der Spalte p die beiden Buchstaben TI findet.
 Eventuell ist dies mein Problem.
 
 Ich hoffe du kannst mir helfen.
 
 danke schonmal.
 
 Gruß sabine
 
 Sub farbenauslesen()
 
 ' Welche Tabelle soll verwendet werden?
  MeineTabelle = Worksheets(1).Name
 
 ' Zeile
 Von = 4 'Start Teil (Zeile)
 Bis = Worksheets(MeineTabelle).UsedRange.Rows.Count
 
 Bis2 = Worksheets(MeineTabelle).UsedRange.Columns.Count
 VBM = Bis2 - 2
 
 ' Spalten
 ' In diesen Zellen stehen jeweils die Informationen über die geprüften Spalten (Start bis End - Spalte)
 TabelleMitSpalteninfo = "Werte"
 ZelleMitStartspalte = "F65"
 ZelleMitEndspalte = "F66"
 
 
 ' Wo stehen die Anzahl der Farben???
 TabellemitFarben = "Werte"
 anzahlZeilen = Bis - Von + 1
 Zelleipgen = "B67"
 
 ipgen = 0
 
 Startspalte = Worksheets(TabelleMitSpalteninfo).Range(ZelleMitStartspalte).Value
 EndSpalte = Worksheets(TabelleMitSpalteninfo).Range(ZelleMitEndspalte).Value
 
 MeineRange = Startspalte & Von & ":" & EndSpalte & Bis
 
 ' Anzahl der Spalten die geprüft werden sollen
 AnzahlSpalten = Worksheets(MeineTabelle).Range(MeineRange).Columns.Count
 
 Worksheets("Werte").Range("I65").Value = AnzahlSpalten
          
 Suchspalte = VBM 'Spalte mit de 'offen'
 
 z = anzahlZeilen
 
 If Cells(z.Row, Suchspalte) <> "offen" Then
 ElseIf Left(Worksheets(MeineTabelle).Cells(j, 16).Value, 2) <> "TI" Then
 A = z.Interior.ColorIndex
 If A = 3 Then ipgen = ipgen + 1
 If A = 50 Then ipgen = ipgen + 1
 If A = 6 Then igpgen = igpgen
 A = z.Font.ColorIndex
 If A = 3 Then igpgen = igpgen + 1
 If A = 50 Then igpgen = igpgen + 1
 If A = 6 Then igpgen = igpgen + 1
 End If
 
 End Sub
 
 
 Holger schrieb am 05.09.2008 13:54:20:
 
 Hallo Sabine,
 quick and dirty. Du musst das Makro an deine Gegebenheiten anpassen (Zellbereiche). Es wertet sowohl Text- als auch Hintergrundfarben an. Ob die Indexwerte deinen Farben entsprechen, musst du auch prüfen!
 Sub farbenauslesen()
 Suchspalte = 4 'Spalte mit de 'offen'
 rZ = 1 'Zahlzelle für rot, Zeile
 rS = 5
 grZ = 2 'Zahlzelle für grün
 grS = 5
 geZ = 3 'Zahlzelle für gelb
 geS = 5
 For Each z In Range("A1:C5") 'Dein Suchbereich
 If Cells(z.Row, Suchspalte) <> "offen" Then
 a = z.Interior.ColorIndex
 If a = 3 Then Cells(rZ, rS) = Cells(rZ, rS) + 1
 If a = 4 Then Cells(grZ, grS) = Cells(grZ, grS) + 1
 If a = 6 Then Cells(geZ, geS) = Cells(geZ, geS) + 1
 a = z.Font.ColorIndex
 If a = 3 Then Cells(rZ, rS) = Cells(rZ, rS) + 1
 If a = 4 Then Cells(grZ, grS) = Cells(grZ, grS) + 1
 If a = 6 Then Cells(geZ, geS) = Cells(geZ, geS) + 1
 End If
 Next
 end sub
 Gruß
 Holger
 
 
 sabine schrieb am 05.09.2008 07:56:49:
 
 Hallo zusammen ,
 habe folgendes Problem. 
 Ich möchte mit VBA in einem Zellbereich, rot grün oder gelb auslesen, wenn diese Farben vorhanden sind, soll in einer anderen Spalte geprüft werden, ob dort nicht "offen" steht. Zeilen auf die diese Kriterien zu treffen, sollen gezählt und in einer Zelle ausgegeben werden.
 
 Ich bin um schnelle Hilfe dankbar.
 
 Gruß Sabine      |