Farben zählen (Spalten und Zeilen weise)

Dieses Thema Farben zählen (Spalten und Zeilen weise) im Forum "Microsoft Office Suite" wurde erstellt von falcon30, 14. Juni 2005.

Thema: Farben zählen (Spalten und Zeilen weise) Hallo zusammen, ich habe eine Tabelle in der ab Zelle AF77 ca 40 Zeilen und 10 Spalten existieren. Die Zellen...

  1. Hallo zusammen,

    ich habe eine Tabelle in der ab Zelle AF77 ca 40 Zeilen und 10 Spalten existieren.
    Die Zellen können drei farben haben (rot, gelb, grün)

    Nun möchte ich in einer anderen Arbeitsmappe Auswertung die Farben Zählen und zwar:
    - Pro Zeile sollen die Farben gezählt und ausgegeben werden
    - Pro Spalte sollen die Farben gezählt und ausgegeben werden


    Ich weis das es ein Thema bzgl Farben zählen gibt:

    http://www.wintotal-forum.de/index.php/topic,82951.0.html

    Doch hier werden nur die Zeilen berücksichtigt. Ich brauche aber auch die Spalten.

    Wie ist das Vorgehen bei solchen Problemen?
    Hätte ich meine wünsche mit in das existierende Thema einfügen müssen, oder ist es OK wenn ich was neues aufmache?

    Vielen Dank im Voraus.

    Grüße
    falcon30
     
  2. also um deine ca. Zahlen genauer zu definieren. Es handelt sich um den Bereich AF77:AP:117 korrekt?

    in welche Zellen sollen die Resultate von der Zeile bzw. Spalte stehen im Tabellenblatt Auswertung?

    mfg billy
     
  3. Hallo falcon,

    wenn ich das richtig sehe, ist das die Fortsetzung /Auswertung deiner Projektmappe. Als Kriterium für die auzuzählenden Spalten sollten die Projektnamen in Spalte C ab Zeile 77 dienen. Also in Spalte C ab Zeile 77 schauen, wieviel Projekte vorhanden sind -> zählen bis Zeile x.

    Quell-Blattname ist Projekte
    Pfad: offen
    Quell-Datei : offen

    Ziel-Datei:Auswertung.xls
    Pfad: offen
    Blattname: offen

    Auflistung: pro Zeile (also pro Projekt) Anzahl rot, gelb, grün
    Auflistung: pro Spalte(also Projekt-Eigenschaften) Anzahl rot, gelb, grün

    So richtig?

    Gruß Matjes :)
     
  4. Hi falcon30,

    so nach->Farbe' sammeln gibts jetzt->Farbe auswerten'   ::)

    Die Konstanten Pfad,Dateiname,Blattname ....  bitte noch anpassen.

    Und dann auf das Makro-Knöpfchen drücken zum Ausprobieren  ;D

    Gruß Matjes  ;)

    Korrektur: Spaltenüberschriften werden aus AF4 und folgrnde geholt.

    Code:
    Option Explicit
     
    Sub AuswertungDerProjektAmpeln()
     
     Const c_QuellPfad = c:\Test
     Const c_QuellDatei = Excel_ProjektAmpel.xls
     Const c_QuellBlattName = Projekte
     Const c_QuelleAmpel As String = AF77->obere linke Ecke
     Const c_QuelleAmpel_Spalten = 10
     Const c_QuelleAmpel_SpaltenUeberschiften = AF4
     Const c_QuelleProjNamen As String = C77
     
     Const c_ZielPfad = c:\Test
     Const c_ZielDatei = Auswertung.xls
     Const c_ZielBlattName = Auswertung
     
    ->zu zählende Farbindexe
     Const c_CInd_rot = 3
     Const c_CInd_gelb = 27->hellgelb =27
     Const c_CInd_gruen = 4
     
     
     Dim s_Quelle_Full As String, l_AnzProjekte As Long
     Dim wbq As Workbook, wsq As Worksheet
     Dim wbz As Workbook, wsz As Worksheet
     Dim l_zeile As Long, x As Long, sp As Long
     Dim l_rot As Long, l_gelb As Long, l_gruen As Long, l_keine As Long
     Dim r_proj As Range, r_Farben As Range, r_SPUeb As Range
     Dim f_SpUeb() As String, f_SPUeb_cnt As Long
     
    ->Quelle öffnen
     If Not myQuellDateiOeffnen( _
          c_QuellPfad, c_QuellDatei, c_QuellBlattName, wbq, wsq) Then
      GoTo Aufraeumen
     End If
     
    ->Anzahl Projekte
     l_AnzProjekte = 0
     Do
      If wsq.Range(c_QuelleProjNamen).Offset(l_AnzProjekte, 0).Value <>  Then
       l_AnzProjekte = l_AnzProjekte + 1
      Else
       Exit Do
      End If
     Loop
     
    ->Spalten-Überschriften besorgen
     ReDim f_SpUeb(1 To 1): f_SPUeb_cnt = 0
     Set r_SPUeb = wsq.Range(c_QuelleAmpel_SpaltenUeberschiften).Offset(0, -1)
     For sp = 1 To c_QuelleAmpel_Spalten
      f_SPUeb_cnt = f_SPUeb_cnt + 1
      ReDim Preserve f_SpUeb(1 To f_SPUeb_cnt)
      f_SpUeb(f_SPUeb_cnt) = r_SPUeb.Offset(0, sp).Value
     Next
     
    ->gibt's Arbeit ?
     If l_AnzProjekte = 0 Then
      MsgBox (Kein Projekt vorhanden.)
     Else
     ->Quelle öffnen
      If Not myZielDateiOeffnen( _
          c_ZielPfad, c_ZielDatei, c_ZielBlattName, wbz, wsz) Then
       GoTo Aufraeumen
      End If
    
     ->Auswertung
      
      l_zeile = 1
     ->Überschrift
      wsz.Cells(l_zeile, 1).Value = _
       Projekt-Auswertung vom  & Format(Now(), dd.mm.yyyy)
      wsz.Cells(l_zeile, 1).Font.Bold = True
      l_zeile = l_zeile + 2
      
     ->Überschrift Anzahl-Farben pro Projekt
      With wsz.Cells(l_zeile, 1): .Value = Projekt: .Font.Bold = True: End With
      With wsz.Cells(l_zeile, 2): .Value = Anz. rot: .Font.Bold = True: End With
      With wsz.Cells(l_zeile, 3): .Value = Anz. gelb: .Font.Bold = True: End With
      With wsz.Cells(l_zeile, 4): .Value = Anz. grün: .Font.Bold = True: End With
      With wsz.Cells(l_zeile, 5): .Value = Anz. keine: .Font.Bold = True: End With
      l_zeile = l_zeile + 1
      
      wsq.Activate
      Set r_proj = wsq.Range(c_QuelleProjNamen).Offset(-1, 0)
      Set r_Farben = wsq.Range(c_QuelleAmpel).Offset(-1, -1)
      
      For x = 1 To l_AnzProjekte
      ->Farben pro Projekt zählen
       l_rot = 0: l_gelb = 0: l_gruen = 0: l_keine = 0
       For sp = 1 To c_QuelleAmpel_Spalten
        With r_Farben.Offset(x, sp)
         If .Interior.ColorIndex = c_CInd_rot Then
          l_rot = l_rot + 1
         ElseIf .Interior.ColorIndex = c_CInd_gelb Then
          l_gelb = l_gelb + 1
         ElseIf .Interior.ColorIndex = c_CInd_gruen Then
          l_gruen = l_gruen + 1
         Else
          l_keine = l_keine + 1
         End If
        End With
       Next
      ->ausgeben
       wsz.Cells(l_zeile, 1).Value = r_proj.Offset(x, 0).Value
       wsz.Cells(l_zeile, 2).Value = l_rot
       wsz.Cells(l_zeile, 3).Value = l_gelb
       wsz.Cells(l_zeile, 4).Value = l_gruen
       wsz.Cells(l_zeile, 5).Value = l_keine
       
       l_zeile = l_zeile + 1
      Next
    
      l_zeile = l_zeile + 1
     ->Überschrift Anzahl-Farben pro Spalte
      With wsz.Cells(l_zeile, 1): .Value = Spalte: .Font.Bold = True: End With
      With wsz.Cells(l_zeile, 2): .Value = Anz. rot: .Font.Bold = True: End With
      With wsz.Cells(l_zeile, 3): .Value = Anz. gelb: .Font.Bold = True: End With
      With wsz.Cells(l_zeile, 4): .Value = Anz. grün: .Font.Bold = True: End With
      With wsz.Cells(l_zeile, 5): .Value = Anz. keine: .Font.Bold = True: End With
      l_zeile = l_zeile + 1
    
      For sp = 1 To c_QuelleAmpel_Spalten
      ->Farben pro Spalte zählen
       l_rot = 0: l_gelb = 0: l_gruen = 0: l_keine = 0
       For x = 1 To l_AnzProjekte
        With r_Farben.Offset(x, sp)
         If .Interior.ColorIndex = c_CInd_rot Then
          l_rot = l_rot + 1
         ElseIf .Interior.ColorIndex = c_CInd_gelb Then
          l_gelb = l_gelb + 1
         ElseIf .Interior.ColorIndex = c_CInd_gruen Then
          l_gruen = l_gruen + 1
         Else
          l_keine = l_keine + 1
         End If
        End With
       Next
      ->ausgeben
       wsz.Cells(l_zeile, 1).Value = f_SpUeb(sp)
       wsz.Cells(l_zeile, 2).Value = l_rot
       wsz.Cells(l_zeile, 3).Value = l_gelb
       wsz.Cells(l_zeile, 4).Value = l_gruen
       wsz.Cells(l_zeile, 5).Value = l_keine
       
       l_zeile = l_zeile + 1
      Next
     End If
     
    Aufraeumen:
     Set wbq = Nothing: Set wsq = Nothing
     Set wbz = Nothing: Set wsz = Nothing
     Set r_proj = Nothing: r_Farben = Nothing: r_SPUeb = Nothing
    End Sub
    Function myZielDateiOeffnen( _
           s_ZielPfad As String, _
           s_ZielDatei As String, _
           s_ZielBlattName As String, _
           wbz As Workbook, _
           wsz As Worksheet) As Boolean
     
     Dim s_Ziel_Full As String
     
     myZielDateiOeffnen = False
     
    ->Quelle öffnen
     s_Ziel_Full = s_ZielPfad & \ & s_ZielDatei
     On Error Resume Next
     Set wbz = Workbooks(s_ZielDatei)
     If Err.Number <> 0 Then
      Err.Clear
      Set wbz = Workbooks.Open(FileName:=s_Ziel_Full)
      If Err.Number <> 0 Then
       Err.Clear
       MsgBox ( _
        Konnte die Ziel-Datei nicht öffnen. & vbLf & _
        s_Ziel_Full)
       Exit Function
      End If
     End If
    ->Auswertungsblatt hinzufügen
     Set wsz = wbz.Worksheets.Add(Before:=wbz.Worksheets(1))
     wsz.Name = s_ZielBlattName & Format(Now(), _yyyymmdd_hhmm)
     On Error GoTo 0
     myZielDateiOeffnen = True
    End Function
    Function myQuellDateiOeffnen( _
           s_QuellPfad As String, _
           s_QuellDatei As String, _
           s_QuellBlattName As String, _
           wbq As Workbook, _
           wsq As Worksheet) As Boolean
     
     Dim s_Quelle_Full As String
     
     myQuellDateiOeffnen = False
     
    ->Quelle öffnen
     s_Quelle_Full = s_QuellPfad & \ & s_QuellDatei
     On Error Resume Next
     Set wbq = Workbooks(s_QuellDatei)
     If Err.Number <> 0 Then
      Err.Clear
      Set wbq = Workbooks.Open(FileName:=s_Quelle_Full)
      If Err.Number <> 0 Then
       Err.Clear
       MsgBox ( _
        Konnte die Quell-Datei nicht öffnen. & vbLf & _
        s_Quelle_Full)
       Exit Function
      End If
     End If
     Set wsq = wbq.Worksheets(s_QuellBlattName)
     On Error GoTo 0
     myQuellDateiOeffnen = True
    End Function
     
  5. Hallo Matjes,

    die Auswertung wird jeden Monat durchgeführt. Ist es möglich sowohl für die Spalten als auch für die Zeilen Auswertung den aktuellen Datum mit auszugeben?

    Die aktuelle Auswertung soll an das Ende der letzten Auswertung hinzugefügt werden.

    Danke!

    Grüße
    falcon30
     
  6. Hallo Matjes,

    das was ich vorhin geschrieben habe kannst Du vergessen. Dein Makro ist echt klasse.

    Ich hätte noch eine bitte:

    Die Spalten werden gerade in folgender Form ausgegeben:
    Spalte1
    Spalte2
    Spalte3
    ...

    Kann die Spaltenangabe ab zelle AF4 übernommen werden.


    Danke!!

    Grüße
    falcon30
     
  7. Hi falcon,

    ist eingebaut (siehe oben).

    Gruß Matjes :)
     
  8. Hi falcon,

    ich hab noch eine Zeile bzgl->Aufraeumen:' hinzugefügt.
    Code:
    Aufraeumen:
      Set wbq = Nothing: Set wsq = Nothing
      Set wbz = Nothing: Set wsz = Nothing
      Set r_proj = Nothing: r_Farben = Nothing: r_SPUeb = Nothing
    Zum Chart:
    Bevor ich dir das 'Wie' erklären kann, solltest du mir das 'Was' erklären.  ;D

    Also:
    Was für ein Chart - Typ
    Wo soll das Chart liegen - eingebettet auf einem Worksheet oder eigenes Blatt(dann Namen definieren)
    Welche Bereiche - Wertebereiche und Bereich der zugehörigen Überschriften und Reihenfolge
    Welche Formate haben die Bereiche
    Welcher Bereich soll die Bezugsachse bilden
    Was für eine Überschrift

    ggf. wie soll die Kopf-/Fußzeile aussehen
    - linkerHeader z.B. Projekt
    - mittlerer Header z.B. Übersicht blablabla
    - rechter Header z.B. Datum
    - linker Footer: z.B. Ersteller/Tel.Nr/Adresse
    - mittler Footer z.B. Seite/Seiten
    - rechter Footer z.B. Dateiname/Blattname

    und was dir noch einfällt.

    Gruß Matjes :)
     
  9. Hallo Matjes,

    vorerst will ich drei Auswertungen durchführen, dafür will ich einmal ein Linienchart und ein Säulen Diagramm erzeugen.

    Die Charts sollen in der Auswertung.xls Datei liegen mit dem worksheet namen Cockpit.

    Die Daten die für die Charts relevant sind, stehen in mehren Worksheets die mit Auswertung_ Anfangen.

    Zwei Liniercharts:
    In dem Liniernchart sollen die Anzahl der Rot bewerteten pro Spalte  angezeigt werden. 

    Wertebereich:
    A46:B52 für das erste Chart
    A53:B55 für das zweite Chart

    Die Daten sehen so aus:

    Zelle      Spalte                                   Anz. rot
    A45 SYS-Anforder-ungsanalyse                   5
    A46 SW-Anforder-ungsanalyse     5
    A47 SW-Design                                     5
    A48 SW-Erstellung                                     5
    A49 Integration und SW-Test                     3
    A50 Systemtest                                     3
    A51 Abnahmetest                                     0
    A51 Projekt-management                     3
    A51 Konfigurations-management     5
    A54 Qualitäts-sicherung                     5

    jetzt soll jedes vorhandene Arbeitsblatt im einem chart angezeigt werden.


    Säulen Diagramm:

    Wertebereich: A44:D44

    Hier soll die Gesamtzahl der gelb, grün und rot bewerten Felder angezeigt werden. Die Daten sind in mehreren Worksheets.

    Daten sehen so aus:                          Anz.rot   Anz. gelb    Anz. grün
    Auswertung_20050615_1251 30 15 7


    Gibt es die Möglichkeit hier Bilder einzufügen, es fällt mir schwer das ganze in Worte zu fassen. Ich habe eine Beispiel Datei mit den Charts angelegt und würde es gerne hier einfügen.



    Grüße
    falcon30
     
Die Seite wird geladen...

Farben zählen (Spalten und Zeilen weise) - Ähnliche Themen

Forum Datum
Word 2003: Zahlen Suchen Und Färben? Microsoft Office Suite 2. März 2008
Zahlen Farben Windows XP Forum 26. Okt. 2005
Outlook 2013 Kalender einfärben Microsoft Office Suite 18. Apr. 2016
Fensterfarben unter Windows ändern Windows 10 Forum 14. Jan. 2016
Farben Windows 10 Forum 10. Aug. 2015