t0laah
Aug 19, 2012
view6210
view9
0
Goto Top

Excel Makro erstellt Grafik aus Tabellendaten - färbt Zellen

GermansolvedQuestionVB for ApplicationsDevelopment
Hallo,
ich möchte eine Maschinenbelegungsplanung in Excel machen.
Die Daten dazu habe ich bereits errechnet.
Jetzt soll eine Tabelle in ein Grafik gewandelt werden.
Exceldiagramme bieten nicht genügend Freiheiten (leerräume zwischen Balken), daher will ich auf einem Blanko-Tabellenblatt Zellen einfärben:
Maschine belegt = Farbe des Jobs
Maschine frei = weis

Ich habe zwei Maschinen und drei Jobs:
Job1 grün
Job2 blau
Job3 rot

Wie kann ich in VBA sagen: Lese Tabelle und färbe die Zellen - also für Job1 von C2 beginnend, fünf (=Dauer) Felder grün färben, dann Job2...)?

Exceldatei hier:
https://dl.dropbox.com/u/8152929/misc/administrator.de/syxbysis_min_v1.x ...

so solls aussehen:
601b5fe059265452b5221c7106bfd5ba
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 189816

Url: https://administrator.de/contentid/189816

Printed on: April 19, 2024 at 10:04 o'clock

9 Comments
Latest comment
Goto Top
Member: bastla
bastla Aug 19, 2012 updated at 13:06:50 (UTC)
Goto Top
Hallo t0laah und willkommen im Forum!

Das ginge anhand Deines Beispiels etwa so:
Option Base 1
Sub MakeGraph()
QuelleAbZeile = 7 'ab dieser Zeile Daten lesen  
QuelleSpalten = Array("C", "F", "H", "J") 'aus diesen Spalteb Daten lesen  

ZielAbZeile = 2 'ab dieser Zeile Daten eintragen / Zellen färben  
ZielAbSpalte = 3 'ab dieser Spalte Daten eintragen / Zellen färben  

MaschinenAnzahl = 2
JobFarben = Array(43, 37, 3) 'Farbwerte für Jobs festlegen  

Cells(ZielAbZeile, ZielAbSpalte).Resize(MaschinenAnzahl, Columns.Count - ZielAbSpalte).Clear 'Zielbereich löschen  

QZ = QuelleAbZeile 'in Startzeile für Quelldaten beginnen  
Do While Cells(QZ, QuelleSpalten(1)).Value <> "" 'solange in der ersten Quellspalte Werte stehen  
    'Daten auslesen  
    Maschine = Cells(QZ, QuelleSpalten(1)).Value
    Job = Cells(QZ, QuelleSpalten(2)).Value
    Dauer = Cells(QZ, QuelleSpalten(3)).Value
    Start = Cells(QZ, QuelleSpalten(4)).Value

    'Zielkoordinaten bestimmen  
    ZZ = ZielAbZeile + Maschine - 1
    ZS = ZielAbSpalte + Start - 1
    
    Cells(ZZ, ZS).Value = "J" & Job 'Jobnummer in erste Zielzelle eintragen  
    If Dauer > 1 Then Cells(ZZ, ZS + 1).Value = "D=" & Dauer 'Dauer in zweite Zielzelle eintragen  
    
    For i = 1 To Dauer 'Zielzellen entsprechend Dauer durchlaufen  
        Cells(ZZ, ZS + i - 1).Interior.ColorIndex = JobFarben(Job) 'Zielzelle entsprechend Jobnummer einfärben  
    Next

    QZ = QZ + 1 'nächste Quellzeile  
Loop
End Sub
Zum Thema (Standard-)Farbcodes ("ColorIndex"-Werte) zB http://excelwelt.de/Excelallg/farb.html

Grüße
bastla
Mitglied: 76109
76109 Aug 19, 2012 updated at 11:32:25 (UTC)
Goto Top
@all
Zu den Farbtabellen wäre vielleicht noch zu erwähnen, dass die große Farbtabelle für Zellformatierungen gedacht sind und die kleine Farbtabelle in Charts (Diagramme) Verwendung findet, wobei die kleine aber auch über die Zellformatierung>Muster für Zellen verwendet werden kann.

Über die Zahlenanordung (ColorIndexe) habe ich mir auch schon den Kopf zerbrochen, aber leider keine vernünftige Erklärung dafür gefundenface-wink

Gruß Dieter
Member: Biber
Biber Aug 19, 2012 updated at 13:29:38 (UTC)
Goto Top
Moin t0laah, bsatla und didi1954,

@t0laah
Willkommen im Forum und danke für die sehr gute und vollständige Frage-Formulierung.

VBA ist nicht so mein Fachgebiet, aber grundsätzlich würde ich anregen, zumindest EIN Feature noch von den Nice-to-have/Machen wir später-Optionen umzubuchen zur Grundfunktionalität des Makros :

  • Der Makro händelt im Moment drei fest verdrahtete Farben für heute auch genau max drei Jobs auf zwei Maschinen
  • die Anzahl der Maschinen kann sicherlich für die Lebensdauer dieser Excellösung als "FIX" unterstellt werden - das sind heute 2 Maschinen und nächsten Dienstag auch noch und am 17. Oktober wohl auch noch
  • Aber die Anzahl Jobs kann variieren, denke ich ... kann <= 3 sein, aber sicherlich auch mal 4 oder mehr.

Deshalb würde ich - wenn ich programmieren könnte - die Zeile 10 in bastlas Lösung..

JobFarben = Array(43, 37, 3) 'Farbwerte für Jobs festlegen

... frühzeitig "dynamisieren", d.h. hier z.B. die Farbwerte aus einem "benannten Bereich" der Tabelle ermitteln, der meinetwegen "Legende" heisst.
Und in dem das visualisiert ist, was t0laah hier beschrieben hat:
Ich habe zwei Maschinen und drei Jobs:
Job1 grün
Job2 blau
Job3 rot

Grüße
Biber
Member: bastla
bastla Aug 19, 2012 updated at 13:16:15 (UTC)
Goto Top
Hallo Biber!

Da ich ja nun leider auch nicht programmieren kann, aber Deinen Vorschlag gut finde, bastle ich eben etwas face-wink:
Option Base 1
Sub MakeGraph()
QuelleAbZeile = 7 'ab dieser Zeile Daten lesen  
QuelleSpalten = Array("C", "F", "H", "J") 'aus diesen Spalteb Daten lesen  
QuelleSpalteJobFarben = "M" 'aus dieser Spalte die Job-Farben ermitteln  

ZielAbZeile = 2 'ab dieser Zeile Daten eintragen / Zellen färben  
ZielAbSpalte = 3 'ab dieser Spalte Daten eintragen / Zellen färben  

MaschinenAnzahl = 2

QZ = QuelleAbZeile 'in Startzeile für Quelldaten beginnen  
Do While Cells(QZ, QuelleSpalteJobFarben).Value <> "" 'solange in der "JobFarbenSpalte" Inhalte stehen  
    JF = JF & " " & Cells(QZ, QuelleSpalteJobFarben).Interior.Color 'Farbe für Job aus Zelle übernehmen  
    QZ = QZ + 1 'nächste Zeile  
Loop
JobFarben = Split(JF) 'Array aus gesammelten Werten erzeugen  

Cells(ZielAbZeile, ZielAbSpalte).Resize(MaschinenAnzahl, Columns.Count - ZielAbSpalte).Clear 'Zielbereich löschen  

QZ = QuelleAbZeile 'in Startzeile für Quelldaten beginnen  
Do While Cells(QZ, QuelleSpalten(1)).Value <> "" 'solange in der ersten Quellspalte Werte stehen  
    'Daten auslesen  
    Maschine = Cells(QZ, QuelleSpalten(1)).Value
    Job = Cells(QZ, QuelleSpalten(2)).Value
    Dauer = Cells(QZ, QuelleSpalten(3)).Value
    Start = Cells(QZ, QuelleSpalten(4)).Value

    'Zielkoordinaten bestimmen  
    ZZ = ZielAbZeile + Maschine - 1
    ZS = ZielAbSpalte + Start - 1
    
    Cells(ZZ, ZS).Value = "J" & Job 'Jobnummer in erste Zielzelle eintragen  
    If Dauer > 1 Then Cells(ZZ, ZS + 1).Value = "D=" & Dauer 'Dauer in zweite Zielzelle eintragen  

    For i = 1 To Dauer 'Zielzellen entsprechend Dauer durchlaufen  
        Cells(ZZ, ZS + i - 1).Interior.Color = JobFarben(Job) 'Zielzelle entsprechend Jobnummer einfärben  
    Next
    QZ = QZ + 1 'nächste Quellzeile  
Loop
End Sub
Es können jetzt vorweg die Zellen M7, M8, M9, ... (auch ein "Verbinden" der Zellen mit der/den Nachbarspalte/n (wie bei den Werten in den Spalten "C" oder "F" ist möglich) jeweils in der gewünschten Farbe des Jobs formatiert und müssen mit einem Eintrag (zB "Job1", "Job2", ...) versehen werden (damit erkennbar ist, wie viele Jobs es gibt) - dann werden diese Farben für die Zielzellen verwendet ...

Da jetzt RGB-Farbwerte verwendet werden, fällt auch die Einschränkung auf die per "ColorIndex" festgelegten Standard-Farben weg.

Grüße
bastla

P.S.: Da das Erweitern "benannter Bereiche" eher umständlich ist, habe ich die Zeile (= 1. Datenzeile, im Beispiel 7) und Spalte für den Beginn der "Legende" doch wieder fest verdrahtet ...
Member: Biber
Biber Aug 19, 2012 updated at 13:28:35 (UTC)
Goto Top
Moin bastla,

danke schön!
Alle weiteren Verfeinerungen können nun wirklich warten, bis sich die heutigen Thermometerwerte halbiert haben..

...ich würde ja noch in Zeile 33 neben den "J"/"Job"-Zeiten eine Rubrik "U" für "Umrüstzeiten" der Maschinen vorsehen - aber hey! was versteh ich schon Maschinenbelegungsplänen....

BTW... ich radele jetzt erstmal zur nächsten Eisdiele... wahrscheinlich sitzt t0laah auch schon da,
Vielleicht solltest du auch mal einfach.... face-wink

Grüße
Biber
Member: bastla
bastla Aug 19, 2012 at 13:36:05 (UTC)
Goto Top
[OT]
Hallo Biber!

Du würdest mir ernsthaft Bewegung zumuten/-trauen? face-wink

Grüße
bastla
[/OT]
Member: Biber
Biber Aug 19, 2012 updated at 16:56:04 (UTC)
Goto Top
[Re: OT]
Moin bastla,

Zitat von @bastla:
[OT]
Hallo Biber!

Du würdest mir ernsthaft Bewegung zumuten/-trauen? face-wink
Ich sach ma' so:
So viel Geduld, auf die Eröffnung eines Eiskugelbringdienstes in deiner Gegend zu warten...
-> das trau ich nicht mal dir zu, und ich halte deine Geduld für schier unerschöpflich.

Nur Mut - die Redensart heisst doch "die Trauben hängen zu hoch" - von Eiskugeln ist nicht die Rede.

Mein Eis vorhin war jedenfalls die Tor- bzw. Radtour wert.
Grüße
bastla
[/OT]

Grüße zurück
Biber
[/Re: OT]
Member: t0laah
t0laah Aug 20, 2012 at 05:09:08 (UTC)
Goto Top
Hallo Bastla, Didi und Biber face-smile

ui, ihr seht ja alle, dass ich hier Frischling bin.. :D

danke für eure Hilfe, vielen Anregungen und Tipps - entschuldigt, dass ich erst jetzt Antworte.

Die Lösung von Bastla hab ich aber gestern noch mitnehmen können (ganz großes DANKE! hätte ich selbst niemals hinbekommen)

Habe mir das jetzt soweit angepasst, dass ich Daten und Grafik getrennt habe (verschiedene Tabellenblätter, DATA und MASTER) und auch mehr Maschinen und Jobs drin habe (2M +3Jobs war nur für dieses Forum - soll ja nicht unnötig kompliziert werden).

Die Tabelle wird je nach Berechnung dynamisch verändert (hab dafür das Lingo [Lindo Systems] und Job-Shop-Scheduling benutzt, falls jemand mal eine ähnliche Problemstellung hat.)

Ich denke meine Fragen sind soweit geklärt.
Danke nochmal an euch! face-smile
Member: Biber
Biber Aug 20, 2012 at 05:57:31 (UTC)
Goto Top
Moin t0laah,

Zitat von @t0laah:
Hallo Bastla, Didi und Biber face-smile

ui, ihr seht ja alle, dass ich hier Frischling bin.. :D

Ich denke meine Fragen sind soweit geklärt.
Danke nochmal an euch! face-smile
Hmmmm, dann noch als kleiner Hinweis an den Forums-Frischling:

Bitte setz den Beitrag auf "Erledigt/Gelöst", wenn die Frage hinreichend beantwortet ist (und du das nächste Mal angemeldet bist).

Danke
Biber
GermansolvedQuestionVB for ApplicationsDevelopment
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 3 CommentsAlexWishaHow to set up and configure a Linux GRE tunnelAlexWisha - 3 CommentsjstrickerWIREGUARD VPN ON UDM PRO BEHIND FRITZBOX - HANDSHAKE DID NOT COMPLETEjstricker - 3 CommentsDaniEnd of Support dates for Office 2016, 2019 Apps und Productivity ServersDani - 1 Comment