Hallo,
ich möchte eine Maschinenbelegungsplanung in Excel machen. Ein Makro soll mir in auf einem Blanko-Tabellenblatt Zellen färben. Ich habe zwei Maschinen und drei Jobs:
Job1 grün — Job2 blau — Job3 rot
so solls aussehen:
https://dl.dropbox.com/u/8152929/misc/gutefrage.net/…
Wie kann ich in VBA sagen: Lese Tabelle und färbe die Zellen (also für Job1 C2:G2 und L3:open_mouth:3 grün)?
Sorry, bin gerade auf dem Weg in den Urlaub. Ganz kurz: man kann jede Zelle ansprechen: Sheets(…).Cells(row,column). Am besten einen Makromitschnitt machen und den Code entsprechend modifizieren. Viel Erfolg
Rainer
Hallo,
eigentlich ist das, was Du da willst eine komplette Programmierung und wir Experten hier wollen den Progammierern ja nicht die Arbeit weg nehmen.
Außerdem scheint es ja für Deinen Arbeitgeber zu sein; der müsste doch Geld für Programmierungen haben?!?!
Aber da es ein kurzer Code ist, will ich mal nicht so sein.
Ich habe es möglichst einfach gestrickt, damit Du es auch warten/ergänzen kannst. Es ginge sehr viel eleganter, aber dann verstehst Du vermutlich nur ‚‚Bahnhof‘‘.
nun der Code
Sub Farbe()
Dim I As Double
Dim Erste\_Zeile As Double
Dim Letzte\_Zeile As Double
Dim My\_Row As Double
Dim My\_Color As Double
Dim Dauer As Double
Dim StartPos As Double
Erste\_Zeile = 7 'der auszuwertenden Tabelle
Letzte\_Zeile = 12 'der auszuwertenden Tabelle
' Zeilen könnte man auch dynamisch auswerten
For I = Erste\_Zeile To Letzte\_Zeile
Select Case Cells(I, 3)
Case 1
My\_Row = 2
Case 2
My\_Row = 3
Case Else
MsgBox "Keine Maschine gefunden"
End Select
Select Case Cells(I, 6)
Case 1
My\_Color = 43 'für Grün
Case 2
My\_Color = 41 'für Blau
Case 3
My\_Color = 3 'für Rot
Case Else
MsgBox "Keinen Job gefunden"
End Select
Dauer = Cells(I, 8)
StartPos = Cells(I, 10) + 2
Range(Cells(My\_Row, StartPos), Cells(My\_Row, StartPos + Dauer - 1)) \_
.Interior.ColorIndex = My\_Color
Next I
End Sub
Bitte My_Color noch anpassen. Der Colorindex ist von Excel-Version zu Version verschieden!
Am besten den Makrorekorder starten, drei Zellen untereinander dann grün, blau, rot färben,
Rekorder stoppen und Werte übernehmen.
Dauer und StartPos haben keine Fehlerroutine und wenn die Zelle leer ist, gibt es einen Fehler + Abbruch. Da darfst Du Dir mal selber Gedanken machen. Kommst Du dann nicht weiter, kanst Du ja nochmal fragen
Hallo trnt,
versuchs mal damit:
Sub Einfaerben()
'Variablendeklaration
Dim Maschine As Single, Job As Single, Start As Single, Dauer As Single
Dim Z As Single, S As Single, I As Single
’
Dim Farbe As Double, Zeile As Single, Von As Single, Bis As Single
’
'Schleife der Eingabe
For Z = 7 To 12
Maschine = Cells(Z, 3).Value
Job = Cells(Z, 6).Value
Start = Cells(Z, 10).Value
Dauer = Cells(Z, 8).Value
'Zuordnung Maschine Zeile
If Maschine = 1 Then Zeile = 2
If Maschine = 2 Then Zeile = 3
If Maschine 3 Then Exit Sub
'Zuordnung Job Farbe
If Job = 1 Then Farbe = 5296274
If Job = 2 Then Farbe = 16764057
If Job = 3 Then Farbe = 255
If Job 3 Then Exit Sub
'Berechnung Range
Von = Start + 2
Bis = Von + Dauer - 1
ActiveSheet.Range(Cells(Zeile, Von), Cells(Zeile, Bis)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = Farbe
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Next
’
End Sub
MfG MwieMichel
Hallo TRNT
ich habe das mal angeschaut. du könntest in der Spalte mit den Jobnamen diese mit der Farbe hinterlegen, die dann oben in der Zeitskala benutzt werden soll. diese Farbe kann durch ein Makro abgefragt werden. Ich habe im Makro alles so definiert, dass du die Exceltabelle anpassen kannst. also zum Beispiel die Liste mit den Jobs an eine andere Position dieses Tabellenblattes positionieren (wenn zum Beispiel 4 Maschinen tätig sind). Dafür musst du dann aber im Excel die Zahlen anpassen (Variabeln zuweisen).
Ich habe das zuweisen der Farbe in eine eigene Funktion abgelegt, die dann immer wieder aufgerufen wird.
Sub TRNT_Zeitskala_abfuellen()
'Variabeln deklarieren:
Dim Dbl_TRNT_Farbcode As Double
Dim Int_TRNT_Zeile As Integer
Dim Int_TRNT_Spalte As Integer
Dim Int_TRNT_Zeile_Erste_Maschine As Integer
Dim Int_TRNT_Spalte_Erste_Maschine As Integer
Dim Int_TRNT_Zeile_Erster_Job As Integer
Dim Int_TRNT_Spalte_Erster_Job As Integer 'wo MaschinenNr steht
Dim Int_TRNT_Spalten_Maschine_Job As Integer
Dim Int_TRNT_Spalten_Job_Dauer As Integer
Dim Dbl_TRNT_Spalten_Job_Farbe As Double
Dim Int_TRNT_Spalten_Dauer_Start As Integer
Dim Int_TRNT_Machinen_Nr As Integer
Dim Int_TRNT_Job_Nr As Integer
Dim Int_TRNT_Dauer As Integer
Dim Int_TRNT_Start As Integer
Dim Int_Schlauffen_Summand As Integer
Dim Str_TRNT_Jobkuerzel As String
'Variabeln zuweisen:
Int_TRNT_Zeile_Erste_Maschine = 2
Int_TRNT_Spalte_Erste_Maschine = 3
Int_TRNT_Zeile_Erster_Job = 7
Int_TRNT_Spalte_Erster_Job = 3
Int_TRNT_Spalten_Maschine_Job = 3
Int_TRNT_Spalten_Job_Dauer = 2
Int_TRNT_Spalten_Dauer_Start = 2
Dbl_TRNT_Spalten_Job_Farbe = Int_TRNT_Spalte_Erster_Job + Int_TRNT_Spalten_Maschine_Job
Int_Schlauffen_Summand = 0
Str_TRNT_Jobkuerzel = „J“
'Schlaufe zum Abarbeiten der Jobs in den Maschinenzeitleiste
While Cells(Int_TRNT_Zeile_Erster_Job + Int_Schlauffen_Summand, Int_TRNT_Spalten_Maschine_Job).Value2 „“
'werte einlesen
Int_TRNT_Machinen_Nr _
= Cells(Int_TRNT_Zeile_Erster_Job + Int_Schlauffen_Summand, _
Int_TRNT_Spalten_Maschine_Job).Value2
Int_TRNT_Job_Nr _
= Cells(Int_TRNT_Zeile_Erster_Job + Int_Schlauffen_Summand, _
Int_TRNT_Spalten_Maschine_Job + Int_TRNT_Spalten_Maschine_Job).Value2
Int_TRNT_Dauer _
= Cells(Int_TRNT_Zeile_Erster_Job + Int_Schlauffen_Summand, _
Int_TRNT_Spalten_Maschine_Job + Int_TRNT_Spalten_Maschine_Job + Int_TRNT_Spalten_Job_Dauer).Value2
Int_TRNT_Start _
= Cells(Int_TRNT_Zeile_Erster_Job + Int_Schlauffen_Summand, _
Int_TRNT_Spalten_Maschine_Job + Int_TRNT_Spalten_Maschine_Job + Int_TRNT_Spalten_Job_Dauer + Int_TRNT_Spalten_Dauer_Start).Value2
'verarbeiten
'Jobnummer einfügen:
Cells(Int_TRNT_Zeile_Erste_Maschine + Int_TRNT_Machinen_Nr - 1, _
Int_TRNT_Start + Int_TRNT_Spalte_Erste_Maschine - 1).Value2 = _
Str_TRNT_Jobkuerzel & Int_TRNT_Job_Nr
'Job einfärben
Dbl_TRNT_Farbcode _
= Cells(Int_TRNT_Zeile_Erster_Job + Int_Schlauffen_Summand, _
Int_TRNT_Spalten_Maschine_Job + Int_TRNT_Spalten_Maschine_Job).Interior.Color
Call TRNT_Einfaerben(Dbl_TRNT_Farbcode, Int_TRNT_Zeile_Erste_Maschine + Int_TRNT_Machinen_Nr - 1, _
Int_TRNT_Start + Int_TRNT_Spalte_Erste_Maschine - 1, Int_TRNT_Dauer + Int_TRNT_Start + Int_TRNT_Spalte_Erste_Maschine - 2)
Int_Schlauffen_Summand = Int_Schlauffen_Summand + 1
Wend
End Sub
Function TRNT_Einfaerben( _
Dbl_TRNT_Farbcode As Double, Int_TRNT_Zeile As Integer, Int_TRNT_Spalte_Beginn As Integer, Int_TRNT_Spalte_Ende As Integer)
With _
Range(Cells(Int_TRNT_Zeile, Int_TRNT_Spalte_Beginn).Address & „:“ & Cells(Int_TRNT_Zeile, Int_TRNT_Spalte_Ende).Address).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = Dbl_TRNT_Farbcode '5296274 hellgrün,
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Function