Hallo zusammen,
Edgar, mit Edatum() alleine geht es nicht, so wie der TE es bisher hat.
Denn er möchte folgende Unterscheidungen in der bedingten Formatierung treffen:
aktueller Monat und offen in Spalte Status -> Farbe = gelb
Datum < Heute und offen in Spalte Status -> Farbe = rot
Deswegen sträubt er sich auch, die Tabellen untereinander zu kopieren. Weil in sehr wenigen Fällen der Intervall abweicht.
Ich habe eine Makrolösung.
Dazu habe ich eine zusätzliche Tabelle in die Datei eingefügt, die ich mit "Gesamtübersicht" benannt habe.
Beim betreten der Tabelle werde die Tabellen aus dem Blatt "PKW HU_AU" dort untereinander kopiert und nach Spalte §Datum PKW" sortiert.
Folgender Code muss deswegen in das Codefenster der Tabelle "Gesamtübersicht" eingefügt werden:
Code:
Private Sub Worksheet_Activate()
Call sortieren
End Sub
Folgenden Code in ein allgemeines Modul einfügen:
Code:
Sub sortieren()
Dim i As Long
Dim s As Long, z As Long
Dim lngZ As Long
Dim lngAnzahl As Long
Dim wksQ As Worksheet
Dim wksSort As Worksheet
Set wksQ = Sheets("PKW HU_AU")
Set wksSort = Sheets("Gesamtübersicht")
Application.ScreenUpdating = False
With wksSort
.Range("A3:G" & .Cells(.Rows.Count, 1).End(xlUp).Row + 1).Clear
End With
With wksQ
lngZ = .Cells(.Rows.Count, 2).End(xlUp).Row
lngAnzahl = Application.CountIf(.Rows(1), "PKW Hauptuntersuchung (TÜV) Abgasuntersuchung")
s = 8
z = 3
For i = 1 To lngAnzahl
wksSort.Cells(z, 1).Resize(lngZ - 2) = .Range(.Cells(3, 2), .Cells(3 + lngZ - 2, 2)).Value
wksSort.Cells(z, 2).Resize(lngZ - 2, 6) = .Range(.Cells(3, s - 5), .Cells(3 + lngZ - 2, s)).Value
s = s + 7
z = z + lngZ - 2
Next i
.Range("F3").Copy
wksSort.Range("E3:E" & (lngZ - 2) * lngAnzahl + 2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
With wksSort
.Range("A3:G" & (lngZ - 2) * lngAnzahl + 2).Sort key1:=.Range("e3"), order1:=xlAscending
.Cells(1, 1).Select
End With
Application.ScreenUpdating = True
End Sub
Bei Bedarf kann er auch jederzeit manuell oder per Schaltfläche gestartet werden.
Damit alles passt, habe ich die Formeln für das Datumund die Bedingte Formatierung angepast.
Hier für den ersten Bereich:
| Arbeitsblatt mit dem Namen 'PKW HU_AU' | | | B | C | D | E | F | G | H | | 1 | PKW Hauptuntersuchung (TÜV) Abgasuntersuchung | | 2 | PKW
| Kennz. | Interv. | Auszuführende Arbeiten | Datum
PKW
| Km-Stand | Status | | 3 | 03.2015 | HD- | 24 Monate. | Haupt.-Abgasuntersuchung | 03.2017 | | Erledigt | | 4 | 05.2015 | HD- | 24 Monate. | Haupt.-Abgasuntersuchung | 05.2017 | | Erledigt | | 5 | 05.2015 | HD- | 24 Monate. | Haupt.-Abgasuntersuchung | 05.2017 | | Erledigt |
|
| Zelle | Formel | | F3 | =DATUM(JAHR(B3); MONAT(B3)+D3; TAG(MONATSENDE(B3;0))) |
| | Zelle | bedingte Formatierung... | Format | | F3 | 1: =UND(JAHR(F3)=JAHR(HEUTE());MONAT(F3)=MONAT(HEUTE());H3="Offen") | abc | | F3 | 2: =UND(JAHR(F3)=JAHR(HEUTE());MONAT(F3)=MONAT(HEUTE());H3="Offen") | abc |
|
| Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg |
Die Formel in den nächsten dann so:
| Arbeitsblatt mit dem Namen 'PKW HU_AU' | | | J | K | L | M | N | O | | 1 | PKW Hauptuntersuchung (TÜV) Abgasuntersuchung | | 2 | Kennz. | Interv. | Auszuführende Arbeiten | PKW
HU/AU | Km-Stand | Status | | 3 | HD- | 24 Monate. | Haupt.-Abgasuntersuchung | 03.2019 | | Offen | | 4 | HD- | 24 Monate. | Haupt.-Abgasuntersuchung | 05.2019 | | Offen | | 5 | HD- | 24 Monate. | Haupt.-Abgasuntersuchung | 05.2019 | | Offen |
|
| Zelle | Formel | | M3 | =DATUM(JAHR(F3); MONAT(F3)+K3; TAG(F3)) |
| | Zelle | bedingte Formatierung... | Format | | M3 | 1: =UND(JAHR(M3)=JAHR(HEUTE());MONAT(M3)=MONAT(HEUTE());O3="Offen") | abc | | M3 | 2: =UND(JAHR(M3)=JAHR(HEUTE());MONAT(M3)=MONAT(HEUTE());O3="Offen") | abc |
|
| Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg |
Die Formel können von den Formelexperten gerne vereinfacht werden.
Unten die Beispielmappe mit den eingearbeiteten Dingen:
Fahrzeugterminierung 2017 03052017 (ati).xlsm (Größe: 38,55 KB / Downloads: 1)
![[-]](https://www.clever-excel-forum.de/images/collapse.png)