AW: Schulungsplan - Auslesen über Überschrift
17.11.2017 14:15:16
Daniel
Hi Werner,
sorry der Link funktioniert wohl nicht. Franz hier aus dem Forum hat mir schon einen VBA Code bereitgestellt, der super funktioniert - nur theoretisch müsste da jetzt der Punkt mit den Überschriften noch eingebunden werden.
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.
Quellcode von 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