Office: (Office 2000) Monat färben mit VBA (Makro)

Hallo zusammen,

ich bin ein Neuling in Sachen VBA und Makro, daher wende ich mich an euch mit der Bitte um Hilfe.

Ich habe eine Tabelle, in der ich manuell in mehrere Zellen unter Spalte A ein Datum eingebe. In Spalte B gebe ich ebenfalls manuell ein Datum ein, dabei wird per bedingter Formatierung ermittelt, ob das Datum unter Spalte B über dem Datum in Spalte C liegt und wenn ja rot gefärbt. In der Spalte C wird das Datum in der selben Zeile aus Spalte A geprüft und per Makro in der selben Zeile unter Spalte C mit DateSerial 6 Monate später eingetragen.

Beispiel:

[table="width: 500, class: outer_border, align: left"]
[tr]
[td][/td]
[td]A[/td]
[td]B[/td]
[td]C[/td]
[/tr]
[tr]
[td]1[/td]
[td]Beginn[/td]
[td]Ende[/td]
[td]späteste Ende[/td]
[/tr]
[tr]
[td]2[/td]
[td]01.01.2015[/td]
[td]03.01.2015[/td]
[td]30.06.2015[/td]
[/tr]
[tr]
[td]3[/td]
[td]usw.[/td]
[td]usw.[/td]
[td]usw.[/td]
[/tr]
[/table]


Nun möchte ich die möglichen zwölf Monate aus Spalte C färben. D.h. Januar rot, Februar gelb usw. Das Jahr und der Tag sollen dabei unwichtig sein, da in jedem Jahr die Monate dieselbe Farbe haben sollen.

Ich benutzte Excel 2000 und habe daher keine Möglichkeit die bedingte Formatierung zu nutzen.

Vielen Dank für eure Unterstützung.

Gruß
fraesh

 

Hi,

wenn deine Zellen bereits mit bedingter Formatierung gefärbt werden, kannst du sie nicht noch zusätzlich mit Füllfarbe formatieren, da die Färbung durch bedingte Formatierung stets Vorrang hat.

Bis später,
Karin

 

Das ist richtig, vielen Dank, für deine Antwort.
Ich habe mich in dieser Hinsicht vielleicht nicht eindeutig ausgedrückt.

Gefärbt mit bedingter Formatierung werden nur die Zellen aus Spalte B. Ich möchte per Makro die Zellen aus Spalte C formatieren.

Es sollen alle Daten in Spalte C gefärbt werden, wobei die Färbung sich auf den Monat bezieht.

Ist das möglich?

Vielen Dank.

 

Laufe in einer Schleife über alle Zeilen und prüfe mittels Month(Cells(laufendeZeile, 3)), welcher Monat ansteht - in einer Select Case-Anweisung kannst du dann festlegen, welche Farbe zu welcher Monatsnummer gehören soll.

Bis später,
Karin

 

Hallo Karin,

so sieht mein Code:

Application.EnableEvents = False 'XXXXXXXXXXXXXXXX
Dim Zelle As Range
If WorksheetFunction.CountA(Range("A2:A1000")) > 0 Then
For Each Zelle In Range("A2:A1000").SpecialCells(xlCellTypeConstants)
If IsEmpty(Zelle.Offset(0, 2)) Then Zelle.Offset(0, 2) = DateSerial(Year(Zelle), Month(Zelle) + 6, Day(Zelle) - 1)
Next Zelle
End If
If WorksheetFunction.CountA(Range("A2:A1000")) > 0 Then
For Each Zelle In Range("A2:A1000").SpecialCells(xlCellTypeConstants)
If Not IsEmpty(Zelle.Offset(0, 2)) Then Zelle.Offset(0, 2) = DateSerial(Year(Zelle), Month(Zelle) + 6, Day(Zelle) - 1)
Next Zelle
End If
Application.EnableEvents = True 'XXXXXXXXXXXXXXXX

Kannst du mir bitte erklären, wie ich die Schleife einbauen kann.


Vielen Dank

Gruß
Arthur

 

Hi Arthur,

dein Code läuft doch bereits in einer Schleife über alle Zellen.

Mir ist allerdings nicht klar, was dein Code tatsächlich machen soll, denn er trägt das Datum ein wenn die Zelle in Spalte C leer ist UND wenn sie nicht leer ist - wo ist denn da der Unterschied?
Und was hat es mit Application.EnableEvents auf sich, wenn der Code ein ganz normales Makro und kein Change-Ereignis des Tabellenblattes ist - geht ja aus deinem Codeschnipsel nicht hervor. Wenn du das Worksheets_Change-Ereignis für deinen Code verwendest - weshalb wird dann jedesmal die gesamte Spalte durchlaufen und das Datum nicht nur für die Target-Zeile eingetragen?
Wozu benötigst du die Prüfung mittels WorksheetFunction.CountA(Range("A2:A1000")) > 0 wenn du doch nur die belegten Zellen mittels SpecialCells(xlCellTypeConstants) berücksichtigst?

Lade doch mal eine Beispielmappe hoch und erkläre ganz genau WAS du eigentlich machen willst.

Bis später,
Karin

 

Hallo Karin,

den Code habe ich nicht selbst geschrieben, es ist ein Codeschnipsel, daher kann ich dir die folgenden Punkte nicht erklären:

WorksheetFunction.CountA(Range("A2:A1000")) > 0
SpecialCells(xlCellTypeConstants)
Application.EnableEvents

Bezogen auf:
Dim Zelle As Range
If WorksheetFunction.CountA(Range("A2:A1000")) > 0 Then
For Each Zelle In Range("A2:A1000").SpecialCells(xlCellTypeConstants)
If IsEmpty(Zelle.Offset(0, 2)) Then Zelle.Offset(0, 2) = DateSerial(Year(Zelle), Month(Zelle) + 6, Day(Zelle) - 1)
Next Zelle
End If
If WorksheetFunction.CountA(Range("A2:A1000")) > 0 Then
For Each Zelle In Range("A2:A1000").SpecialCells(xlCellTypeConstants)
If Not IsEmpty(Zelle.Offset(0, 2)) Then Zelle.Offset(0, 2) = DateSerial(Year(Zelle), Month(Zelle) + 6, Day(Zelle) - 1)
Next Zelle
End If

Wenn die Zelle in Spalte C leer ist, dann fülle ein Datum. Ist sie nicht leer, dann ändere das Datum auf ein neues in der Zukunft. Da in Spalte A das Datum ggf. in der selben Zelle geändert werden kann.

Leider klappt es nicht die Datei hochzuladen, aber ich stelle dir hier den ganzen Code zur Verfügung.

Code:

Private Sub Zeile_Click()
'
' Zeilen_einfügen Makro
'

    If Selection.Areas.Count > 1 Then
        MsgBox ("Bitte nicht mehrere Bereiche auswählen!")
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    Selection.EntireRow.Insert
    ' ACHTUNG: Das With darf nicht 1 drüber, da sich durch das Insert die Selection ändert
    With Selection.EntireRow
        .Offset(1, 0).Resize(1).Copy
        .PasteSpecial Paste:=xlPasteFormulas
    End With
    Application.ScreenUpdating = True

End Sub

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Wenn mehr als eine Zelle markiert wurde dann Makro beenden

                    
Application.EnableEvents = False 'XXXXXXXXXXXXXXXX
Dim Zelle As Range
If WorksheetFunction.CountA(Range("A2:A1000")) > 0 Then
For Each Zelle In Range("A2:A1000").SpecialCells(xlCellTypeConstants)
If IsEmpty(Zelle.Offset(0, 2)) Then Zelle.Offset(0, 2) = DateSerial(Year(Zelle), Month(Zelle) + 6, Day(Zelle) - 1)
Next Zelle
End If
If WorksheetFunction.CountA(Range("A2:A1000")) > 0 Then
For Each Zelle In Range("A2:A1000").SpecialCells(xlCellTypeConstants)
If Not IsEmpty(Zelle.Offset(0, 2)) Then Zelle.Offset(0, 2) = DateSerial(Year(Zelle), Month(Zelle) + 6, Day(Zelle) - 1)
Next Zelle
End If
Application.EnableEvents = True 'XXXXXXXXXXXXXXXX

End Sub

Vielen Dank.

 

Hi Arthur,

ohne hochgeladene Beispielmappe kann man nicht testen was da tatsächlich abläuft.
Dein Code im Worksheet_Chande-Ereignis wird bei JEDER Änderung im Tabellenblatt ausgeführt - ich würde denken dann das vollkommen unnötig ist. Außerdem solltest du mal ganz genau beschreiben wie du in deiner Mappe vorgehst und was genau wann passieren soll.

Bis später,
Karin

 

Hallo Karin,

tut mir leid für die späte Antwort, ich war beruflich eingespannt und muss dieses Ergebnis im Rahmen meiner Arbeit erbringen, habe aber damit hauptberuflich nichts zu tun.

Aufgrund deiner Tipps habe ich es folgernmaßen lösen können:

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub 'Bearbeiten mehrerer Zeilen wird abgefangen
If Target = "" Then
Target.Offset(0, 2).ClearContents
ElseIf Not IsDate(Target) Then
Target.Offset(0, 2).ClearContents
Else:
Target.Offset(0, 2) = DateSerial(Year(Target), Month(Target) + 6, Day(Target) - 1)
End If

monat1 = Month(Target.Offset(0, 2))
If monat1 = 1 Then Target.Offset(0, 2).Interior.ColorIndex = 37
If monat1 = 2 Then Target.Offset(0, 2).Interior.ColorIndex = 40
If monat1 = 3 Then Target.Offset(0, 2).Interior.ColorIndex = 39
If monat1 = 4 Then Target.Offset(0, 2).Interior.ColorIndex = 44
If monat1 = 5 Then Target.Offset(0, 2).Interior.ColorIndex = 33
If monat1 = 6 Then Target.Offset(0, 2).Interior.ColorIndex = 36
If monat1 = 7 Then Target.Offset(0, 2).Interior.ColorIndex = 10
If monat1 = 8 Then Target.Offset(0, 2).Interior.ColorIndex = 46
If monat1 = 9 Then Target.Offset(0, 2).Interior.ColorIndex = 38
If monat1 = 10 Then Target.Offset(0, 2).Interior.ColorIndex = 54
If monat1 = 11 Then Target.Offset(0, 2).Interior.ColorIndex = 48
If monat1 = 12 Then Target.Offset(0, 2).Interior.ColorIndex = 53
End Sub

Vielen Dank.