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 |