Schulungsplan

Guten Tag zusammen, stehe vor folgender Aufgabe. Ich habe eine Tabelle mit mehreren Arbeitsblättern die vom Aufbau her immer identisch sind. So ist in Spalte T das "Ist-Datum", in Spalte "W" Bewertung 1, Spalte "X" Bewertung 2 und _ Spalte "Z" Bewertung 3. Folgende Bedingungen sind für die Bewertungsfelder einzuhalten: Spalte "W" Bewertung 1 -> älter als 2 Monaten Spalte "X" Bewertung 2 -> älter als eine Woche Spalte "Z" Bewertung 3 -> älter als 2 Monate Im Arbeitsblatt "Erinnerung_Bewertung" in der gleichen Excel Datei soll nun in der vorgegeben _ Struktur die Auswertung erfolgen. Bereich -> Name des Arbeitsblattes Schulungsdatum - "Ist-Datum" aus dem jeweiligen Arbeitsblatt Name - "Teilnehmer" aus dem jeweiligen Arbeitsblatt Schulungsname - "Schulungstitel" aus dem jeweiligen Arbeitsblatt Bewertung - Auflisten welche Bewertung fehlt (Bewertung 1, Bewertung 2, Bewertung 3) Es soll nun geprüft werden, ob für die Bewertungen 1-3 das Ist-Datum hinfällig ist, wenn kein Eintrag in der Zelle der jeweiligen Bewertung vorhanden ist und das Datum hinfällig _ ist, soll die Ausgabe in Arbeitsblatt "Erinnerung_Bewertung" erfolgen. Die Zellen der jeweiligen Bewertung sind jeweils mit einem Dropdown ausgestattet, in dem dann entweder Bewertung erfolgt, Bewertung nicht erfolgt, oder "leer" enthalten ist. Ausgabe in Arbeitsblatt "Erinnerung_Bewertung" soll nur stattfinden, wenn Datum hinfällig ist _ und die Zelle der Bewertung leer ist. Vielen Dank. Daniel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Schulungsplan

07.11.2017 06:00:09

fcs

AW: Schulungsplan

07.11.2017 09:09:58

Daniel

AW: Schulungsplan

07.11.2017 18:06:00

fcs

AW: Schulungsplan

08.11.2017 07:25:49

Daniel

AW: Schulungsplan

08.11.2017 21:09:34

fcs

AW: Schulungsplan

09.11.2017 08:23:26

Daniel

AW: Schulungsplan

10.11.2017 00:32:23

fcs

AW: Schulungsplan

10.11.2017 14:39:00

Daniel

Sub Bewertung_ueberfaellig() Dim wksErin As Worksheet Dim wksBer As Worksheet Dim Zei_E As Long, Zei_B As Long Dim SpaDatum As Long, SpaBew1 As Long, SpaBew2 As Long, SpaBew3 As Long Dim SpaTeil As Long, SpaSchul As Long Dim datIst_Datum As Date, strSchul As String, strTeil As String Dim datBew(1 To 3) As Date, strBew(1 To 3) As String, intBew As Integer Set wksErin = ActiveWorkbook.Worksheets("Erinnerung_Bewertung") 'Spalten in den Bereichsblättern SpaTeil = 1 'Name Teilnehmer 'anpassen !! SpaSchul = 3 'Schulungstitel 'anpassen !! SpaDatum = 20 'Ist-Datum SpaBew1 = 23 'Bewertung 1 SpaBew2 = 24 'Bewertung 2 SpaBew3 = 26 'Bewertung 3 With wksErin Zei_E = .Cells(.Rows.Count, 1).End(xlUp).Row If MsgBox("Altdaten im Blatt """ & .Name & """ löschen?", _ vbYesNo, "Bewertungen prüfen") = vbYes Then If Zei_E > 1 Then .Range(.Rows(2), .Rows(Zei_E)).ClearContents Zei_E = 1 End If End If End With For Each wksBer In ActiveWorkbook.Worksheets Select Case wksBer.Name Case wksErin.Name, "Tabelle XYZ" 'Tabellen ohne Bereichsdaten überspringen, ggf. weitere Namen ergänzen Case Else 'Bereichs-Tabellen With wksBer For Zei_B = 2 To .Cells(.Rows.Count, SpaTeil).End(xlUp).Row strTeil = .Cells(Zei_B, SpaTeil).Text strSchul = .Cells(Zei_B, SpaSchul).Text datIst_Datum = .Cells(Zei_B, SpaDatum).Value strBew(1) = .Cells(Zei_B, SpaBew1).Text strBew(2) = .Cells(Zei_B, SpaBew2).Text strBew(3) = .Cells(Zei_B, SpaBew3).Text 'überfälliges Datum für die Bewertungen ermitteln datBew(1) = DateSerial(Year(datIst_Datum), Month(datIst_Datum) + 2, 0) _ _ + Day(datIst_Datum) datBew(2) = datIst_Datum + 2 * 7 datBew(3) = datBew(1) For intBew = 1 To 3 If strBew(intBew) = "" And datBew(intBew)

Vielen Dank Franz, irgendwie passt da noch was nicht mit den Bezeichnungen bzw. Werten aus der Tabelle. Habe die Spaltennummern angepasst gehabt, aber es kommen nicht die richtigen Werte mit, kannst du das mal bitte anschauen, die Datei findest du im Anhang.
Wenn nun für Schulung Nummer 1 die Bewertungen 1-3 fehlen, dann wird das Ergebnis jeweils untereinander geschrieben ?
also
Schulung 1 -> Bewertung 1
Schulung 1 -> Bewertung 2
Schulung 1 -> Bewertung 3
Danke dir.
Muster:

https://www.herber.de/bbs/user/117489.txt
_

So hatte ich mir das Ergbenis vorgestellt gehabt, ist es möglich die Bewertung zu einer Schulung nebeneinander zu schreiben?
Vorlage:


https://www.herber.de/bbs/user/117490.txt
_

Bereich = Arbeitsblatt Name
Bewertung d. Teilnehmer (1 Woche) = Bewertung 1
Wirksamkeit (2 Monate später) = Bewertung 2
Bewertung druch GF (2 Monate) = Bewertung 3
Gruß
Daniel

Sub Bewertung_ueberfaellig() Dim wksErin As Worksheet Dim wksBer As Worksheet Dim Zei_E As Long, Zei_B As Long Dim SpaDatum As Long, SpaBew1 As Long, SpaBew2 As Long, SpaBew3 As Long Dim SpaTeil As Long, SpaSchul As Long Dim bolPruef As Boolean Dim spaBew As Long Dim datIst_Datum As Date, strSchul As String, strTeil As String Dim datBew(1 To 3) As Date, strBew(1 To 3) As String, intBew As Integer Set wksErin = ActiveWorkbook.Worksheets("Erinnerung_Bewertung") 'Spalten in den Bereichsblättern SpaTeil = 3 'Name Teilnehmer 'anpassen !! SpaSchul = 15 'Schulungstitel 'anpassen !! SpaDatum = 20 'Ist-Datum SpaBew1 = 23 'Bewertung 1 SpaBew2 = 24 'Bewertung 2 SpaBew3 = 26 'Bewertung 3 With wksErin Zei_E = .Cells(.Rows.Count, 1).End(xlUp).Row If MsgBox("Altdaten im Blatt """ & .Name & """ löschen?", _ vbYesNo, "Bewertungen prüfen") = vbYes Then If Zei_E > 1 Then .Range(.Rows(2), .Rows(Zei_E)).ClearContents Zei_E = 1 End If End If End With For Each wksBer In ActiveWorkbook.Worksheets Select Case wksBer.Name Case wksErin.Name, "Schulung Extern" 'Tabellen ohne Bereichsdaten überspringen, ggf. weitere Namen ergänzen Case Else 'Bereichs-Tabellen With wksBer For Zei_B = 10 To .Cells(.Rows.Count, SpaTeil).End(xlUp).Row - 1 strTeil = .Cells(Zei_B, SpaTeil).Text strSchul = .Cells(Zei_B, SpaSchul).Text datIst_Datum = .Cells(Zei_B, SpaDatum).Value strBew(1) = .Cells(Zei_B, SpaBew1).Text strBew(2) = .Cells(Zei_B, SpaBew2).Text strBew(3) = .Cells(Zei_B, SpaBew3).Text 'überfälliges Datum für die Bewertungen ermitteln datBew(1) = datIst_Datum + 7 'Bewertung durch Teinehmer 1 Woche nach _ Istdatum datBew(2) = DateSerial(Year(datIst_Datum), Month(datIst_Datum) + 2, 0) _ _ + Day(datIst_Datum) 'Wirksamkeit 2 Monate nach Istdatum datBew(3) = DateSerial(Year(datIst_Datum), Month(datIst_Datum) + 2, 0) _ _ + Day(datIst_Datum) 'Bewertung GF 2 Monate nach Istdatum 'prüfen, ob Bewertungen fehlen und überfällig sind bolPruef = False For intBew = 1 To 3 If strBew(intBew) = "" And datBew(intBew)

Hallo Daniel,
ich hab das Makro nochmals angepasst/erweitert bezüglich des Ist-Datums.
- Leereintrag wird übersprungen
- Zell-Textinhalt wird auf gültiges Datum überprüft
- Bei Eintrag mit Bindestrich wird der Text nach dem Bindestrich auf gültiges Datum überprüft
Somit werden Einträge wie
2.2.17
14.6.17 - 16.6.17
14.6-16.6.2017
ohne Fehler im Makro verarbeitet.
Ergibt die Datumsprüfung/Umwandlung Werte &lt 31.12.1960 werden diese nicht als Istdatum übernommen.
Alle Zeilen mit Problemen beim Istdatum werden in einer MsgBox angezeigt.
Gruß
Franz

Sub Bewertung_ueberfaellig()
Dim wksErin As Worksheet
Dim wksBer As Worksheet
Dim Zei_E As Long, Zei_B As Long
Dim SpaDatum As Long, SpaBew1 As Long, SpaBew2 As Long, SpaBew3 As Long
Dim SpaTeil As Long, SpaSchul As Long
Dim bolPruef As Boolean, bolProblem As Boolean
Dim spaBew As Long
Dim datIst_Datum As Date, strSchul As String, strTeil As String
Dim datBew(1 To 3) As Date, strBew(1 To 3) As String, intBew As Integer
Dim strDatum As String, strMsg As String
Set wksErin = ActiveWorkbook.Worksheets("Erinnerung_Bewertung")
'Spalten in den Bereichsblättern
SpaTeil = 3     'Name Teilnehmer    'anpassen !!
SpaSchul = 15    'Schulungstitel     'anpassen !!
SpaDatum = 20   'Ist-Datum
SpaBew1 = 23    'Bewertung 1
SpaBew2 = 24    'Bewertung 2
SpaBew3 = 26    'Bewertung 3
With wksErin
Zei_E = .Cells(.Rows.Count, 1).End(xlUp).Row
If MsgBox("Altdaten im Blatt """ & .Name & """ löschen?", _
vbYesNo, "Bewertungen prüfen") = vbYes Then
If Zei_E > 1 Then
.Range(.Rows(2), .Rows(Zei_E)).ClearContents
Zei_E = 1
End If
End If
End With
For Each wksBer In ActiveWorkbook.Worksheets
Select Case wksBer.Name
Case wksErin.Name, "Schulung Extern"
'Tabellen ohne Bereichsdaten überspringen, ggf. weitere Namen ergänzen
Case Else
'Bereichs-Tabellen
With wksBer
For Zei_B = 10 To .Cells(.Rows.Count, SpaTeil).End(xlUp).Row - 1
bolProblem = False
With .Cells(Zei_B, SpaDatum)
strDatum = Trim(.Text)
If strDatum = "" Then GoTo Next_Line 'leeres Istdatum überspringen
'Prüfen, ob Bindestrich in Zelltext vorhanden
If InStr(1, .Text, "-") > 0 Then
'Text nach dem Bindestrich als Datum übernehmen
strDatum = Trim(Mid(.Text, InStr(1, .Text, "-") + 1))
End If
If IsDate(strDatum) Then
If UBound(Split(strDatum, "."))  2 Then
'Datm enthält nicht 2 Punkte
bolProblem = True
ElseIf Val(Split(strDatum, ".")(0)) > 31 _
Or Val(Split(strDatum, ".")(0))  12 _
Or Val(Split(strDatum, ".")(1))  "" Then
MsgBox "Blattname - Zeile : Datumseintrag" & strMsg, vbOKOnly + vbInformation, _
"Zeilen mit Problem beim Istdatum"
End If
End Sub

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread