PDA

Vollständige Version anzeigen : Termine in eine Übersicht eintragen und von da in entsprechende Tabellen Kopieren


Knutschkugel
18.07.2014, 17:26
Hallo,
sitze grade an einen Projekt fest und weiß nicht weiter.
Habe eine Übersichtsseite wo alle Termine Eingetragen werden, jetzt hätte ich Aber gerne das es anhand des Datums und der Uhrzeit die Termine in das entsprechende Tabellenblatt kopiert. Sollte eine Terminnummer doppelt vergeben sein möchte ich gerne das es Farblich hervorgehoben wird in der Übersicht.
Was wäre dafür der beste Ansatz?
Wünschenswert wäre es noch das die Übersicht nach KW aus und eingeblendet wird über die Sortierfunktion das ist aber erstmal nebensächlich.

MfG

aloys78
19.07.2014, 11:31
Hallo,

ein paar Fragen zu deiner Datei:

Verstehe ich das richtig, dass es eine solche Datei für jeden Monat gibt ?

Sind die Tabellenblätter für die einzelnen Tage schon eingerichtet oder sind sie beim ersten anfallenden Termin für den Tag noch zu erstellen ?

Warum haben die Tabellenblätter im Namen eine lfd Nummer und nicht den Kalendertag ?

Wann wird das Blatt Eintragungen erstellt ?

Wieviel Positionen fallen monatlich an (Größenordnung) ?

Finden während des Monats Änderungen statt (Neuzugänge, Löschungen, Updates bestehender Einträge) ?

ME bietet sich hier eine VBA-Lösung an.

Gruß
Aloys

Knutschkugel
20.07.2014, 08:42
Hallo,
-diese Datei gibt es montan für jede Woche (da es auch noch ein Diagramm gibt wie weit an der Planvorgabe man dran ist über die Woche) (siehe Anhang)
-die Tabellenblätter und und Datein gibt es schon vorgefertigt für die nächsten vier Wochen.
-Eigentlich haben die Tabellenblätter als Bezeichnung einen Wochentag (hatte das hier nur wieso auch immer nicht gemacht)
-Termine werden erstellt sobald "Frachtfüherer" anrufen und sagen Sie können dann das und das Liefern.
-Wöchentlich fallen gute 150 Positionen an sprich im Monat wären das 600-700 Positionen

für weitere Vorschläge zur Verbesserung bin ich gerne offen

aloys78
20.07.2014, 22:06
Hallo,

anbei ein Lösungsvorschlag:
- Doppel werden in Quell-Tabelle per Bedingter Formatierung markiert
- die Verteilung auf die Tages-Tabellen erfolgt nach Betätigung des Buttons, wobei vorher der alte Inhalt gelöscht wird.
- für die Verteilung auf Vor- und Nachmittag habe ich die Grenze 14:00 definiert (kann über vTime angepasst werden).

Gruß
Aloys

Knutschkugel
21.07.2014, 08:47
WOW riesen Dank.
Schaut genauso aus wie es werden sollte. Wollte mir grade mal anschauen wie das bewerkstelligt hast um zu lernen und es auch umzusetzen für die Zukunft.Aber irgendwie habe ich deine Eingaben auf dem ersten Blick nicht gefunden, werde es mir nachher nochmal in ruhe zu Hause anschauen.

Knutschkugel
21.07.2014, 12:04
Hallo,
da das so gut geklappt habt würde es ja jetzt auch sin machen die Liste bsp. Quartalsweise zu nutzen werde es dahingehend noch Testen mit der Datenmenge und den Tabs.
-----------------
Wäre es jetzt aber noch möglich die Grafik in der Wochenübersicht so gestallten das er es einmal anzeigt für die Aktuelle Woche und die Darauffolgende Woche.
-----------------
Habe mal noch eine Komplizierte Frage denke ich, ist es möglich das ganze als fortlaufend zu nutzen erste Tab wo die ganzen eingaben gemacht werden und das auf die Wochentage aufgesplittet wird undich bei den Wochentagen halt nur die aktuelle bzw die zukünftige KW mir raus filter? ist wie gesagt dann die Frage ob das mit der Grafik in der Wochenübersicht noch so machbar ist.

Hoffe ihr wisst was ich meine :-)

Danke schonmal im vorraus

aloys78
21.07.2014, 14:09
Hallo Knutschkugel,
Aber irgendwie habe ich deine Eingaben auf dem ersten Blick nicht gefunden, ...
Welche Eingaben meinst Du ?
... ist es möglich das ganze als fortlaufend zu nutzen erste Tab wo die ganzen eingaben gemacht werden und das auf die Wochentage aufgesplittet wird undich bei den Wochentagen halt nur die aktuelle bzw die zukünftige KW mir raus filter? ist wie gesagt dann die Frage ob das mit der Grafik in der Wochenübersicht noch so machbar ist.
Verstehe ich das richtig, dass du auch Daten für die zukünftigen Wochen hast ?
Ich sehe überhaupt kein Problem darin, auf Knopfdruck nur die Tage der aktuellen und der darauffolgenden Woche anzuzeigen.
Für die Anzeige würden dann 2 x 6 Tabellenblätter benötigt. Zur leichteren Unterscheidung sollten dann die Bezeichungen der Tab-Blätter unterschiedliche Namen haben, wie zB Montag_1 und Montag_2 oder Montag KW 26 und Montag KW 27.
Für das Anpassen der Grafik sehe ich auch keine Probleme. Denkbar wäre es auch 2 Grafiken nebeneinander zu stellen.

Also beschreibe konkret, was du möchtest und dann sehen wir weiter.

Gruß
Aloys

Knutschkugel
21.07.2014, 17:39
Danke erstmal Vorab für deine Hilfe.
Mit dieser Änderung bzw diesem Update ist es ja nun möglich das ich jetzt wie momentan nicht mehr für jede Woche eine neue Datei erstellen muss. Jetzt wäre es ja auch möglich Quartalsweise bzw vielleicht wen es die Daten verarbeiten kann auch Jährlich zu Arbeiten mit einer Datei. *träum*

Würde jetzt unter "Eintragungen" sehr gerne Fortschreibend alle Sachen eintragen, siehe geändertes bsp.
Ist es hier jetzt möglich auch zu Filtern nach den Kalenderwochen ? (siehe Bild)

Jetzt werden diese Daten ja "leider nur" nach den Wochentagen sortiert ist es auch möglich dies nach dem Richtigen Datum + Wochentag zu sortieren?
Würde dafür gerne unten die Tage so bestehen lassen wie sie sind.

Hier Sollte die Auswahl dann entsprechend der Kalender Wochen Auswahl im "Eintragungs Tab" erfolgen.

Die Grafik in der Wochenübersicht sollte denke ich dahingehend das zur Aktuell Angezeigten Woche anzeigen + die darauffolgende Woche.

Anhang auch nochmal die Excel Datei incl. aller Daten bzw wie es gedacht ist

aloys78
22.07.2014, 06:33
Hallo Knutschkugel,

Nachstehend ein paar Ideen für die Umsetzung; dabei unterstelle ich folgendes Modell
- Eintragungen enthält die Termine eines Kalenderjahres
- In Eintragungen sollen die Positionen nach Datum aufsteigend sortiert enthalten sein
- Es bleibt bei den Registern Montag bis Samstag
- In diesen Registern soll eine beliebige Kalenderwoche abgebildet werden können
- In Wochenendübersicht wird in Diagramm 1 die ausgewählte KW sowie im nebenstehenden Diagramm 2 die darauffolgende Woche angezeigt .

Ideen für die Umsetzung
- Neuer Button Sortieren: sortiert alle Positionen aufsteigend nach Datum in Sp A
- Auswahl der gewünschten KW für die Anzeige:
Default ist aktuelle KW. Gewünschte KW kann per KW-Nr oder Datum ausgewählt werden
Die Auswahl einer KW ist nur möglich, wenn diese in Forecast wertemäßig voll abgedeckt wird
- Betätigen des Button Update Tagesblätter zeigt in den Registern Mo –Sa die Werte der ausgewählten Kalenderwoche an
- Es werden für die Erstellung des Diagramm 2 sechs weitere Register (Montag_2, …) eingeführt, die aber ausgeblendet bleiben und jeweils mit Werten der darauffolgenden Woche gefüllt sind.

Deckt sich das mit deinen Vorstellungen ?

Außerdem: welche Excel-Version hast du?

Gruß
Aloys

Knutschkugel
22.07.2014, 07:28
das Deckt sich sehr genau mit meinen Vorstellungen :D

Excel 2013

aloys78
22.07.2014, 08:32
Hallo Knutschkugel,
Excel 2013
Dann kannst du ja die seit Version 2010 unterstützte Formel
=KALENDERWOCHE(A1;21)
nutzen, die eine KW nach DIN liefert.
das Deckt sich sehr genau mit meinen Vorstellungen
Und was bedeutet das ?
Wenn du die neue Datei mit den genannten Änderungen zur Verfügung stelltst, würde ich den Code entsprechend anpassen.
Da du bei den Blättern Mo - Sa bisher die KW über das Datum ermittelst, müßtest du zukünftig umgekehrt die jeweiligen Datumswerte aus der KW ableiten; dazu könnte eine KW-Tabelle mit dem jeweiligen Anfangs- und Endedatum eine Hilfe sein.

Gruß
Aloys

Knutschkugel
22.07.2014, 11:09
Datum + KW wird jetzt bei jeden Wochentag mitangezeigt (hatte ich gestern abend noch gemacht)

aloys78
22.07.2014, 15:35
Hallo Knutschkugel,
Datum + KW wird jetzt bei jeden Wochentag mitangezeigt
Das mag sein, aber in welcher Datei ?

Auch die Umsetzung der Vorschläge konnte ich nicht erkennen.

Gruß
Alyos

Knutschkugel
23.07.2014, 17:33
In der Hoch geladenen, ganz oben steht das doch.
Oder habe ich jetzt was falsch verstanden?

die Termine des Kalenderjahres kommen ja Tag Täglich dazu manchmal nur einen Tag im voraus aber es gibt auch wieder Termine die sind eine Woche im voraus.


beim Rest bin ich noch am Suchen nach der Umsetzung tue mich da aber leider sehr schwer (wäre da über deine Hilfe sehr dankbar)

Aktuelle Version der Datei mal angehängt, wie bekomme ich es hin das er jetzt das auch für die Wochentage Montag & Montag_2 die richtigen Daten einträgt und auch nur dann wen Dieses Datum oben steht und es ansonsten nicht einblendet? Momentan ist es ja so das er es einblendet nur weil das Datum auf ein Montag fällt wobei das datum dahingehend scheinbar keine rolle spielt.

aloys78
23.07.2014, 21:52
Hallo Knutschkugel,
In der Hoch geladenen, ganz oben steht das doch.
Ja, aber in E2 steht noch die falsche KW-Formel (Parameter 1 statt 21)
Aber das Problem war ein anderes. Jetzt hast du eine neue Version hochgeladen mit den zusätzlichen Tabellenblättern.

Aus meiner Sicht ist noch offen das Tabellenblatt Hintergrunddaten. Auf Basis deiner letzten Datei anbei hierzu ein Vorschlag. Spiel mal mit Eingaben verschiedener Jahreszahlen in Eintragungen.
Meine Frage: wie werden die erste und die letzte Woche eines Jahres behandelt, vor allem, wenn sie KW eines anderen Jahres sind.

Das Eintragen des Datums in die Wochentage-Blätter könnte man per VBA erledigen.

Gruß
Aloys

Knutschkugel
24.07.2014, 06:15
Hallo aloys78,

nimmt ja langsam gestallt an :-)

Wie wird der eintrag "Update Tagesblätter" angepasst das es anhand des Datums oben in E/F 1 einsortiert wird? es wird immer noch anhand der Wochentage Sortiert, Sprich bei Montag habe ich die Daten vom 07/14/21.07.2014 drin stehen.

Müsste ja aber ungefäher so ausehen
Termin
07.07.2014 = Montag
14.07.2014 = Montag_2
21.07.2014 = wird noch nicht mit angezeigt erst wen die Anzuzeigende Kalenderwoche das oben genannte Datum auflistet.

Habe in der Datenüberprüfung bei der anzuzeigenden KW noch die Hintergrunddaten angepasst.

Frage zur Sortier Funktion mit Früh und Spätschicht ist es möglich da auch nochmal zu unterteilen? Meine Damit ein Unterteilung der Felder das wir auf 4 felder kommen und nicht wie jetzt auf 2 wo von 06:00 - 14:00 Uhr & 15:00 - 24:00 Uhr geschaut wird. Oder möchte ich da jetzt zuviel von Excel ? Hoffe doch nicht im grunde sind es ja nur noch Feinheiten die angepasst werden müssen (denke ich mir zumindest so)

riesen Dank nochmal an diese Stelle für deine Mithilfe

aloys78
24.07.2014, 07:59
Hallo Knutschkugel,

für mich ist noch offen: welche KW zu berücksichtigen sind, da nach DIN ggf Tage zu Beginn des Jahres zur letzten KW des alten Jahres gehören, bzw die letzten Tage des Jahres ggf zur 1. KW des neuen Jahres.
Meine Vorstellung:
- berücksichtigt werden nur die nach DIN ermittelten KW mit den dazugehörigen Datumswerten, wie ich sie im Blatt Hintergrunddaten dargestellt habe.
Wie wird der eintrag "Update Tagesblätter" angepasst
Mein Vorschlag: per VBA
- über eingegebene KW werden Beginn und Ende der KW ermittelt und die Daten in den Blättern Mo - Sa und Mo_2 bis Sa_2 entsprechend angepasst
Frage zur Sortier Funktion mit Früh und Spätschicht ist es möglich da auch nochmal zu unterteilen?
Das ist mir egal; lege nur fest, wie die zeitlichen Abgrenzungen sind und mache einen entsprechenden Update in den Ergebnisblättern.
21.07.2014 = wird noch nicht mit angezeigt erst wen die Anzuzeigende Kalenderwoche das oben genannte Datum auflistet.

Angezeigt werden in Mo - Sa die Daten der ausgewählten KW und in Mo_2 bis Sa_2 die Daten der KW + 1.

Und noch ein Punkt zur Eingabe der KW; eingegeben werden darf nur 1 bis zur Max-KW minus 1
Dazu sehe ich 2 Möglichkeiten:
- dein bisheriges Verfahren, alle zur Auswahl zu stellen, oder
- die KW einzutippen und per Datenprüfung (benutzerdefiniert und Formel) auf Plausibiltät zu prüfen

Also: bitte klären die Frage KW und hochladen der aktualisierten Datei.

Gruß
Aloys

Knutschkugel
24.07.2014, 17:08
Hallo,

Ich denke ist das Jahr zu ende (31.12...) würde ich eine Neue Datei nehmen (alte Kopieren und Daten entfernen) es wären ja aus momentaner Sicht dann Maximal 2-3 Wochen wo mit Zwei Dateien gearbeitet wird.

Werde morgen mich mal an die Zeitlichen Abgrenzungen machen.

Irgendwie Funktioniert das bei mir nicht mit dem nach Datum Eintragen nicht (Update Tagesblätter ist in V2.4 bei mir jetzt ohne Funktion)

Von Beitrag 16 meine Datumsaufzählung tragt er alle drei Daten bei der alten Version in Montag ein ich sehe das alles unter dem Montag dem 21.07.2014 :-(

aloys78
24.07.2014, 20:14
Hallo Knutschkugel,

in 2.4 ist noch der alte Code. Mit der Anpassung warte ich, bis du die veränderte Datei zur Verfügung stelltst.

Gruß
Aloys

Knutschkugel
09.08.2014, 21:20
Hallo Leider hat es etwas gedauert aber in der Zwischenzeit gab es auch Privat einige änderungen (Eltern werden etc...)

So nun zum wesentlichen zurück^^
Im anhang befindet sich die veränderte Datei

p.s. Eine Frage habe ich noch zur Wochenübersicht
Ich würde da gerne Zwei Diagrame übereinander legen das eine Tranzparent (Säulendiagram) jedoch verdecken mir die Säulen die Line und ich bekomme das nicht Tranzparant genug Vielleicht hat da ja noch jemand ideen ?

Knutschkugel
10.08.2014, 19:51
Mit der Wochenübersicht habe ich jetzt doch noch selbst hinbekommen :-)

aloys78
11.08.2014, 13:40
Hallo Knutschkugel,
Mit der Wochenübersicht habe ich jetzt doch noch selbst hinbekommen
Wenn ich es richtig sehe, dann ist jetzt noch die Verteilung auf die neuen Wochentageblätter offen.
Lade doch mal die aktuelle Datei mit einer ausreichenden Zahl an Positionen in Tabelle Eintragungen hoch.

Gruß
Aloys

Knutschkugel
11.08.2014, 21:00
Hoffe die Eintragungen reichen erstmal?

Danke nochmal für deine Hilfe und Geduld

aloys78
12.08.2014, 11:05
Hallo Knutschkugel,

anbei eine neue Version:
Option Explicit

'=======================================================================
' Version 3 vom 12.08.2014
'=======================================================================

Private Sub CommandButton1_Click()
'=======================================================================
' Update Tagesblätter
'=======================================================================
Dim qr As Long 'Zeilen# in Quelltabelle
Dim qc As Long 'Spalten# in Quelltabelle
Dim zr As Long 'Zeilen# in Zieltabelle
Dim zc As Long 'Spalten# in Zieltabelle
Dim LoL_Q As Long 'Letzte Zeile Quelldatei darauffolgende Woche
Dim sh As Worksheet 'Sheet-Name ausgewählte Woche
Dim dName As String 'Dateiname
Dim KW As Double 'Kalenderwoche der aktuellen Position
Dim erg As Variant 'Egebnis Match-Operation
Dim iJahr As Integer 'Jahr für Datenauswahl
Dim iKW As Double 'KW für Datenauswahl
Dim sZeile As Long 'Start-Zeile im Quadranten
Dim sw As Boolean
Const sSx As String = "_2" 'Suffix Dateinamen daraufffolgende Woche
Const vTime1 As Date = 11.25 / 24 'Obergrenze 1. Quadrant
Const vTime2 As Date = 14.5 / 24 'Obergrenze 2. Quadrant
Const vTime3 As Date = 19.25 / 24 'Obergrenze 3. Quadrant

'************************************************************************
' prüfe Plausibilität Vergleichswerte
'************************************************************************
With ActiveSheet
LoL_Q = .Cells(Rows.Count, "B").End(xlUp).Row 'Letzte Datenzeile
iKW = .Range("J8") 'ausgewählte KW
'check, ob Eingabedaten vorhanden
If LoL_Q < 2 Then
MsgBox "Keine Daten im Tabellenblatt !", vbCritical
Exit Sub
End If
'Check, ob gültiges Jahr
If IsNumeric(.Range("J5")) Then 'ausgewähltes Jahr
iJahr = Range("J5")
Else
MsgBox "ausgewähltes Jahr ist ungültig !", vbCritical
Exit Sub
End If

'************************************************************************
' Leeren Tagesblätter für ausgewählte und darauffolgende Woche
'************************************************************************
On Error GoTo Error_handling
For Each sh In ThisWorkbook.Sheets
Select Case sh.Name
Case "Montag", "Dienstag", "Mittwoch", "Donnerstag", "Freitag", "Samstag" 'ausgewählte Woche
Union(sh.Range("B12:H21"), sh.Range("K12:Q21"), sh.Range("B31:H40"), sh.Range("K31:Q40")).ClearContents
Case "Montag" & sSx, "Dienstag" & sSx, "Mittwoch" & sSx, "Donnerstag" & sSx, "Freitag" & sSx, "Samstag" & sSx 'darauffolgende Woche
Union(sh.Range("B12:H21"), sh.Range("K12:Q21"), sh.Range("B31:H40"), sh.Range("K31:Q40")).ClearContents
End Select
Next sh
On Error GoTo 0

'************************************************************************
' Quelldaten zeilenweise auf die Tagesblätter verteilen
'************************************************************************
Application.ScreenUpdating = False
For qr = 2 To LoL_Q
KW = WorksheetFunction.WeekNum(.Range("A" & qr), 21) 'Kalenderwoche der aktuellen Position

'Name Wochentag ermitteln
If KW = iKW Or KW = iKW + 1 Then
dName = Format(Range("A" & qr), "dddd") 'Name Wochentag
If KW = iKW + 1 Then dName = dName & sSx 'Name Wochentga_2
Set sh = Worksheets(dName)

'Ermitteln Koordination für die Zieltabelle
Select Case Range("E" & qr) 'Uhrzeit
Case Is <= vTime1 '1. Quadrant
sZeile = 12
zc = 2
Case Is <= vTime2 '2. Quadrant
sZeile = 31
zc = 2
Case Is <= vTime3 '3. Quadrant
sZeile = 12
zc = 11
Case Else '4. Quadrant
sZeile = 31
zc = 11
End Select

'Ermitteln nächste freie Zeile im Quadranten und speichere dort die Daten
sw = False
For zr = sZeile To sZeile + 9
If sh.Cells(zr, zc) = "" Then
.Range("B" & qr & ":H" & qr).Copy Destination:=sh.Cells(zr, zc)
sw = True
Exit For
End If
Next zr
If sw = False Then
MsgBox "Eintragung Zeile " & qr & Chr(10) _
& "konnte nicht eingefügt werden" & Chr(10) _
& "Tabelle " & dName, vbExclamation
End If
End If
Next qr
End With

Error_handling:
If Err.Number <> 0 Then
MsgBox "Prozedur abgebrochen ! & chr(10)" _
& "Fehler " & Err.Number & " " & Err.Description
End If
On Error GoTo 0
Application.ScreenUpdating = True
MsgBox "Übernahme der Daten ist abgeschlossen !", vbInformation
End Sub


Gruß
Aloys

Knutschkugel
13.08.2014, 21:03
Hallo,

mit im Test hat es Funktioniert :-)
jedoch scheitert es jetzt bei der Praktischen Umsetzung
Trage jetzt die Daten ein und bekomme nun folgende Fehlermeldung.
Reicht das schon oder brauchst du noch weitere Fehler um das einzugrenzen?

Danke im voraus

aloys78
13.08.2014, 22:17
Hallo Knutschkugel,
Reicht das schon oder brauchst du noch weitere Fehler um das einzugrenzen?
Die Bilder helfen da nicht weiter !
Das einfachste wäre, wenn du die Datei zur Verfügung stellst; ggf kannst du ja bestimmte Daten wie zB Frachtführer in Eintragungen anonymisieren.

Gruß
Aloys

Knutschkugel
14.08.2014, 05:50
Hallo Aloys,
habe dir die Datei bzw Link mal per privat Nachricht gesand (Dropbox) da die datei für hier zu groß ist

aloys78
15.08.2014, 06:48
Hallo Knutschkugel,

anbei ein überarbeiteter Code mit folgenden Änderungen:
- Leerzeilen in Eintragungen werden übersprungen
- Formeln werden übertragen
- Sonntags-Datum wird abgefangen, farblich markiert; bei Programmende wird die Anzahl dieser Fehler angezeigt

Damit es funktioniert, mußt du im Blatt Eintragungen in Sp H mit absoluter Adressierung speichern, zB
=Dummy_Werte!$C$46

Ansonsten empfehle ich im Blatt Hintergrungddaten in A2 folgende Formel einzufügen:
=DATUM(Eintragungen!$J$5;1;1)

Gruß
Aloys

Und hier die neue Version:
Option Explicit

'=======================================================================
' Version 5 vom 15.08.2014
'=======================================================================

Private Sub CommandButton1_Click()
'=======================================================================
' Update Tagesblätter
'=======================================================================
Dim qr As Long 'Zeilen# in Quelltabelle
Dim qc As Long 'Spalten# in Quelltabelle
Dim zr As Long 'Zeilen# in Zieltabelle
Dim zc As Long 'Spalten# in Zieltabelle
Dim LoL_Q As Long 'Letzte Zeile Quelldatei darauffolgende Woche
Dim sh As Worksheet 'Sheet-Name ausgewählte Woche
Dim dName As String 'Dateiname
Dim KW As Double 'Kalenderwoche der aktuellen Position
Dim erg As Variant 'Egebnis Match-Operation
Dim iJahr As Integer 'Jahr für Datenauswahl
Dim iKW As Integer 'KW für Datenauswahl
Dim mKW As Integer 'maximal mögliche KW
Dim sZeile As Long 'Start-Zeile im Quadranten
Dim f As Long 'Anzahl Fehler
Dim sw As Boolean
Const sSx As String = "_2" 'Suffix Dateinamen daraufffolgende Woche
Const vTime1 As Date = 11.25 / 24 'Obergrenze 1. Quadrant
Const vTime2 As Date = 14.5 / 24 'Obergrenze 2. Quadrant
Const vTime3 As Date = 19.25 / 24 'Obergrenze 3. Quadrant

'************************************************************************
' prüfe Plausibilität Vergleichswerte
'************************************************************************
With ActiveSheet
'Initialisieren Werte
LoL_Q = .Cells(Rows.Count, "B").End(xlUp).Row 'Letzte Datenzeile
.Range("A2:A" & LoL_Q).Interior.ColorIndex = xlNone 'eventuell vorhandene farbliche Markierung entfernen
iKW = .Range("J8") 'ausgewählte KW
'check, ob Eingabedaten vorhanden
If LoL_Q < 2 Then
MsgBox "Keine Daten im Tabellenblatt !", vbCritical
Exit Sub
End If
'Check, ob gültiges Jahr
If IsNumeric(.Range("J5")) Then 'ausgewähltes Jahr
iJahr = Range("J5")
Else
MsgBox "ausgewähltes Jahr ist ungültig !", vbCritical
Exit Sub
End If
'gültige Kalenderwoche
mKW = WorksheetFunction.Max(Worksheets("Hintergrunddaten").Range("C3:C54")) - 1
If iKW > mKW Then
MsgBox "Ungültige Kalenderwoche !" & Chr(10) _
& "Maximal zulässig für das Jahr " & iJahr & " ist " & mKW, vbCritical
Exit Sub
End If

'************************************************************************
' Leeren Tagesblätter für ausgewählte und darauffolgende Woche
'************************************************************************
For Each sh In ThisWorkbook.Sheets
Select Case sh.Name
Case "Montag", "Dienstag", "Mittwoch", "Donnerstag", "Freitag", "Samstag" 'ausgewählte Woche
Union(sh.Range("B12:H21"), sh.Range("K12:Q21"), sh.Range("B31:H40"), sh.Range("K31:Q40")).ClearContents
Case "Montag" & sSx, "Dienstag" & sSx, "Mittwoch" & sSx, "Donnerstag" & sSx, "Freitag" & sSx, "Samstag" & sSx 'darauffolgende Woche
Union(sh.Range("B12:H21"), sh.Range("K12:Q21"), sh.Range("B31:H40"), sh.Range("K31:Q40")).ClearContents
End Select
Next sh

'************************************************************************
' Quelldaten zeilenweise auf die Tagesblätter verteilen
'************************************************************************
Application.ScreenUpdating = False
For qr = 2 To LoL_Q
If .Range("A" & qr) = "" Then GoTo Weiter 'Leerzeile
KW = WorksheetFunction.WeekNum(.Range("A" & qr), 21) 'Kalenderwoche der aktuellen Position

'Name Wochentag ermitteln
If KW = iKW Or KW = iKW + 1 Then
dName = Format(.Range("A" & qr), "dddd") 'Name Wochentag
If dName = "Sonntag" Then
f = f + 1 'Fehler zählen
.Range("A" & qr).Interior.ColorIndex = 6 'fehlerhaftes Datum markieren
GoTo Weiter
End If
If KW = iKW + 1 Then dName = dName & sSx 'Name Wochentga_2
On Error GoTo Error_handling
Set sh = Worksheets(dName)
On Error GoTo 0

'Ermitteln Koordination für die Zieltabelle
Select Case .Range("E" & qr) 'Uhrzeit
Case Is <= vTime1 '1. Quadrant
sZeile = 12
zc = 2
Case Is <= vTime2 '2. Quadrant
sZeile = 31
zc = 2
Case Is <= vTime3 '3. Quadrant
sZeile = 12
zc = 11
Case Else '4. Quadrant
sZeile = 31
zc = 11
End Select

'Ermitteln nächste freie Zeile im Quadranten und speichere dort die Daten
sw = False
For zr = sZeile To sZeile + 9
If sh.Cells(zr, zc) = "" Then
.Range("B" & qr & ":G" & qr).Copy Destination:=sh.Cells(zr, zc)
.Range("H" & qr).Copy
sh.Cells(zr, zc + 6).PasteSpecial Paste:=xlPasteFormulas
Application.CutCopyMode = False
sw = True
Exit For
End If
Next zr
If sw = False Then
MsgBox "Eintragung Zeile " & qr & Chr(10) _
& "konnte nicht eingefügt werden" & Chr(10) _
& "Tabelle " & dName, vbExclamation
End If
End If
Weiter:
Next qr
End With

Error_handling:
If Err.Number <> 0 Then
MsgBox "Prozedur abgebrochen !" & Chr(10) _
& "Fehler " & Err.Number & " " & Err.Description & Chr(10) _
& "Tabellenblatt " & dName & " fehlt !", vbCritical
Else
MsgBox "Übernahme der Daten ist abgeschlossen !" & Chr(10) _
& "Anzahl Fehler: " & f, IIf(f = 0, vbInformation, vbExclamation)
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Knutschkugel
15.08.2014, 19:15
Funktioniert jetzt Perfekt :-)
eine Frage noch das Updaten der Tagesblätter geht das schneller wen man die Fehlerprüfung deaktiviert ?

aloys78
15.08.2014, 20:02
Hallo,
eine Frage noch das Updaten der Tagesblätter geht das schneller wen man die Fehlerprüfung deaktiviert ?
Bei der mir vorliegenden Datei mit fast 800 Zeilen dauert die Verarbeitung 4 Sek, wovon auf die Eingangs-Prüfung etwa 5% entfällt.

Kannst du mal näher erläutern ?
- um wieviel Zeilen geht es maximal ?
- wie lange dauert es ganz konkret ?

Ggf müßte dann ein anderer Lösungsansatz gewählt werden. Dazu wäre es sinnvoll, diese Datei zur Verfügung zu stellen.

Gruß
Aloys

Knutschkugel
16.08.2014, 06:40
mh lag wohl an mein Rechner gestern das es so Lange gedauert hat :-(
Habe das die Felder für die Einträge nochmal verändert.
an welchen Stellen des Code müssten änderungen erfolgen ?
das mann so was selbst anpassen könnte ? Irgendwie haut er mir jetzt 11:15 Termine mit ins erste Feld ;-')

aloys78
16.08.2014, 22:40
Hallo Knutschkugel,
Habe das die Felder für die Einträge nochmal verändert.
Nachstehend eine neue Code-Version, die die neuen Feldgrenzen berücksichtigt. Da du nur das neue Blatt Montag geliefert hast, konnte ich das Ganze nur eingeschränkt testen.
Irgendwie haut er mir jetzt 11:15 Termine mit ins erste Feld
Klar – da du das so definiert hast. Die Frühschicht I geht von 6:00 bis 11:15; nach meinem Verständnis sind damit alle Positionen abgedeckt, die >= 6:00 und <= 11:15 sind. Bisher gab es die Überschneidung mit Frühschicht II, die um 11:15 beginnt.
Vorschlag: Frühschicht I endet um 11:14
an welchen Stellen des Code müssten änderungen erfolgen ?
Das habe ich komplett geändert; die Zeiten werden den Tabellenblättern direkt entnommen im o.a. Sinne. Von- und Bis-Wert sind jeweils mit einbezogen.
Das heißt, wenn du die Schichten in den Blättern änderst, wird das vom Code automatisch berücksichtigt
Vorschlag: Eintragungen, die außerhalb der Zeitgrenzen liegen, zB von 19:16 bis 19:59, werden wie der Sonntag als Fehler behandelt und entsprechend markiert.

Sollten noch Fehler auftreten, dann bitte wieder eine komplette Datei mit ausreichend vielen Eintragungen zur Verfügung stellen, damit vernünftig getestet werden kann.

Gruß
Aloys

Option Explicit

'=======================================================================
' Version 8.1 vom 17.08.2014
'=======================================================================

Private Sub CommandButton1_Click()
'=======================================================================
' Update Tagesblätter
'=======================================================================
Dim qr As Long 'Zeilen# in Quelltabelle
Dim qc As Long 'Spalten# in Quelltabelle
Dim zr As Long 'Zeilen# in Zieltabelle
Dim zc As Long 'Spalten# in Zieltabelle
Dim LoL_Q As Long 'Letzte Zeile Quelldatei darauffolgende Woche
Dim sh As Worksheet 'Sheet-Name ausgewählte Woche
Dim dName As String 'Dateiname
Dim KW As Double 'Kalenderwoche der aktuellen Position
Dim erg As Variant 'Egebnis Match-Operation
Dim iJahr As Integer 'Jahr für Datenauswahl
Dim iKW As Integer 'KW für Datenauswahl
Dim mKW As Integer 'maximal mögliche KW
Dim sZeile As Long 'Start-Zeile im Quadranten
Dim fDatum As Long 'Anzahl Datum-Fehler
Dim fUhrzeit As Long 'Anzahl Uhrzeit Fehler
Dim sw As Boolean
Const sSx As String = "_2" 'Suffix Dateinamen daraufffolgende Woche

'************************************************************************
' prüfe Plausibilität Vergleichswerte
'************************************************************************
With ActiveSheet
'Initialisieren Werte
LoL_Q = .Cells(Rows.Count, "B").End(xlUp).Row 'Letzte Datenzeile
.Range("A2:A" & LoL_Q).Interior.ColorIndex = xlNone 'eventuell vorhandene farbliche Markierung Datum entfernen
.Range("E2:E" & LoL_Q).Interior.ColorIndex = xlNone 'eventuell vorhandene farbliche Markierung Uhrzeit entfernen
iKW = .Range("J8") 'ausgewählte KW
'check, ob Eingabedaten vorhanden
If LoL_Q < 2 Then
MsgBox "Keine Daten im Tabellenblatt !", vbCritical
Exit Sub
End If
'Check, ob gültiges Jahr
If IsNumeric(.Range("J5")) Then 'ausgewähltes Jahr
iJahr = Range("J5")
Else
MsgBox "ausgewähltes Jahr ist ungültig !", vbCritical
Exit Sub
End If
'gültige Kalenderwoche
mKW = WorksheetFunction.Max(Worksheets("Hintergrunddaten").Range("C3:C54")) - 1
If iKW > mKW Then
MsgBox "Ungültige Kalenderwoche !" & Chr(10) _
& "Maximal zulässig für das Jahr " & iJahr & " ist " & mKW, vbCritical
Exit Sub
End If

'************************************************************************
' Leeren Tagesblätter für ausgewählte und darauffolgende Woche
'************************************************************************
For Each sh In ThisWorkbook.Sheets
Select Case sh.Name
Case "Montag", "Dienstag", "Mittwoch", "Donnerstag", "Freitag", "Samstag" 'ausgewählte Woche
Union(sh.Range("B11:H22"), sh.Range("K11:Q22"), sh.Range("B31:H42"), sh.Range("K31:Q42")).ClearContents
Case "Montag" & sSx, "Dienstag" & sSx, "Mittwoch" & sSx, "Donnerstag" & sSx, "Freitag" & sSx, "Samstag" & sSx 'darauffolgende Woche
Union(sh.Range("B11:H22"), sh.Range("K11:Q22"), sh.Range("B31:H42"), sh.Range("K31:Q42")).ClearContents
End Select
Next sh

'************************************************************************
' Quelldaten zeilenweise auf die Tagesblätter verteilen
'************************************************************************
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For qr = 2 To LoL_Q
KW = WorksheetFunction.WeekNum(.Range("A" & qr), 21) 'Kalenderwoche der aktuellen Position

'Name Wochentag ermitteln
If KW = iKW Or KW = iKW + 1 Then
dName = Format(.Range("A" & qr), "dddd") 'Name Wochentag
If dName = "Sonntag" Then
fDatum = fDatum + 1 'Fehler zählen
.Range("A" & qr).Interior.ColorIndex = 6 'fehlerhaftes Datum markieren
GoTo Weiter
End If

'If dName <> "Montag" Then GoTo Weiter 'nur Test
'If KW <> iKW Then GoTo Weiter

If KW = iKW + 1 Then dName = dName & sSx 'Name Wochentga_2
On Error GoTo Error_handling
Set sh = Worksheets(dName)
On Error GoTo 0

'Ermitteln Koordination für die Zieltabelle
If CDate(.Range("E" & qr)) >= sh.Range("E4") And CDate(.Range("E" & qr)) <= sh.Range("G4") Then
sZeile = 11
zc = 2
ElseIf CDate(.Range("E" & qr)) >= sh.Range("E24") And CDate(.Range("E" & qr)) <= sh.Range("G24") Then
sZeile = 31
zc = 2
ElseIf CDate(.Range("E" & qr)) >= sh.Range("N4") And CDate(.Range("E" & qr)) <= sh.Range("P4") Then
sZeile = 11
zc = 11
ElseIf CDate(.Range("E" & qr)) >= sh.Range("N24") And CDate(.Range("E" & qr)) <= sh.Range("P24") Then
sZeile = 31
zc = 11
Else
fUhrzeit = fUhrzeit + 1 'fehlerhafte Uhrzeit
Range("E" & qr).Interior.ColorIndex = 6 'gelb markieren
GoTo Weiter 'Position nicht verarbeiten
End If

'Ermitteln nächste freie Zeile im Quadranten und speichere dort die Daten
sw = False
For zr = sZeile To sZeile + 11
If sh.Cells(zr, zc) = "" Then
.Range("B" & qr & ":H" & qr).Copy Destination:=sh.Cells(zr, zc)
sw = True
Exit For
End If
Next zr
If sw = False Then
MsgBox "Eintragung Zeile " & qr & Chr(10) _
& "konnte nicht eingefügt werden" & Chr(10) _
& "Tabelle " & dName, vbExclamation
End If
End If
Weiter:
Next qr
End With

Error_handling:
If Err.Number <> 0 Then
MsgBox "Prozedur abgebrochen !" & Chr(10) _
& "Fehler " & Err.Number & " " & Err.Description & Chr(10) _
& "Tabellenblatt " & dName & " fehlt !", vbCritical
Else
MsgBox "Übernahme der Daten ist abgeschlossen !" & Chr(10) _
& "Anzahl Uhrzeit-Fehler " & fUhrzeit & Chr(10) _
& "Anzahl Datum-Fehler: " & fDatum, IIf(fDatum + fUhrzeit = 0, vbInformation, vbExclamation)
End If
On Error GoTo 0
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.Calculate
End Sub

Knutschkugel
17.08.2014, 10:06
Hallo der neue Code Funktioniert perfekt :)

Mit der Frühschicht hast du mich gleich auf ein Fehler in der Tabelle hingewiesen *Danke* Habe es entsprechend angepasst und damit wurde mir eigentlich die Problematik mit dem Zeiten Bewusst. Habe dahingehend mal noch die Hintergrunddaten ergänzt das er sich die Uhrzeiten anhand der KW mit ziehen soll. (was wäre hier die Bessere Alternative für VBA oder per Formel SVERWEIS zb.?)

Habe noch ein Uhrzeit Fehler den ich nicht ganz Verstehe geht da momentan um die 20:00 Uhr Einträge ein Teil übernimmt er, ein anderen Teil meldet er als Fehler

Es sind jetzt 2000 Testeinträge

Link Zum Download wegen der Datei Größe: Dropbox Download (https://www.dropbox.com/s/yrpyow9g4xv1ee5/%C3%9Cberarbeitung.xlsm)

aloys78
17.08.2014, 15:20
Hallo Knutschkugel,
Habe noch ein Uhrzeit Fehler den ich nicht ganz Verstehe geht da momentan um die 20:00 Uhr Einträge ein Teil übernimmt er, ein anderen Teil meldet er als Fehler
Ehrlich gesagt, das verstehe ich im Moment auch noch nicht.
Wenn ich die 12 markierten Uhrzeiten 20:00 manuell eingebe, dann funktioniert es einwandfrei. Werden die Uhrzeiten auf unterschiedliche Weise erzeugt ?
Habe dahingehend mal noch die Hintergrunddaten ergänzt das er sich die Uhrzeiten anhand der KW mit ziehen soll.(was wäre hier die Bessere Alternative für VBA oder per Formel SVERWEIS zb.?)
Sorry - mir ist nicht klar, was du damit sagen willst, daher verstehe ich auch die Frage nicht !

VG
Aloys

Knutschkugel
17.08.2014, 15:24
Hallo aloys78,

nein die Uhrzeiten wurden normal eingegeben( hatte mir da jetzt erstmal geholfen mit einer Sekunde zugeben aber wenn du sagst Uhrzeit komplett neu eingeben hilft auch passt es )

Zu der Frage: ist es möglich das die Schichtzeiten anhand der KW sich mit verändert?

MfG

aloys78
17.08.2014, 15:37
Hallo,
ist es möglich das die Schichtzeiten anhand der KW sich mit verändert?
Verstehe ich das richtig ?
Für jede KW oder auch für KW-Gruppen sollen jeweils eigene Schichtzeiten definiert werden können ?

Du kennst doch den Spruch - nichts ist unmöglich !

Dann müsstest du mal eine Übersicht liefern, wie das konkret aussehen soll.

VG
Aloys

Knutschkugel
17.08.2014, 15:40
Hallo,
das habe ich in den Hintergrunddaten schon angegeben ;-)

Denke die Übersicht ist da gewahrt da links daneben ja die KW steht so das man die Zeiten einfach ausrichten kann und weiß welche KW welche Zeiten gelten

Danke für deine Mühe

aloys78
17.08.2014, 16:49
Hallo,
das habe ich in den Hintergrunddaten schon angegeben
Da hatte ich nicht nachgeschaut.
Anbei eine neue Code-Version, die ich aus Zeitgründen nur kurz testen konnte.

VG
Aloys

Option Explicit

'=======================================================================
' Version 9 vom 17.08.2014
'=======================================================================

Private Sub CommandButton1_Click()
'=======================================================================
' Update Tagesblätter
'=======================================================================
Dim qr As Long 'Zeilen# in Quelltabelle
Dim qc As Long 'Spalten# in Quelltabelle
Dim zr As Long 'Zeilen# in Zieltabelle
Dim zc As Long 'Spalten# in Zieltabelle
Dim LoL_Q As Long 'Letzte Zeile Quelldatei darauffolgende Woche
Dim sh As Worksheet 'Sheet-Name ausgewählte Woche
Dim ws_H As Worksheet 'Sheet Hintergrunddaten
Dim h As Long 'Zeilen# Hintergrunddaten
Dim dName As String 'Dateiname
Dim KW As Double 'Kalenderwoche der aktuellen Position
Dim erg As Variant 'Egebnis Match-Operation
Dim iJahr As Integer 'Jahr für Datenauswahl
Dim iKW As Integer 'KW für Datenauswahl
Dim mKW As Integer 'maximal mögliche KW
Dim sZeile As Long 'Start-Zeile im Quadranten
Dim fDatum As Long 'Anzahl Datum-Fehler
Dim fUhrzeit As Long 'Anzahl Uhrzeit Fehler
Dim KW_Bereich As String 'Bereich Kalenderwochen in Hintergrunddaten
Dim sw As Boolean
Const sSx As String = "_2" 'Suffix Dateinamen daraufffolgende Woche

'************************************************************************
' prüfe Plausibilität Vergleichswerte
'************************************************************************
With ActiveSheet
'Initialisieren Werte
LoL_Q = .Cells(Rows.Count, "B").End(xlUp).Row 'Letzte Datenzeile
.Range("A2:A" & LoL_Q).Interior.ColorIndex = xlNone 'eventuell vorhandene farbliche Markierung Datum entfernen
.Range("E2:E" & LoL_Q).Interior.ColorIndex = xlNone 'eventuell vorhandene farbliche Markierung Uhrzeit entfernen
iKW = .Range("J8") 'ausgewählte KW
'check, ob Eingabedaten vorhanden
If LoL_Q < 2 Then
MsgBox "Keine Daten im Tabellenblatt !", vbCritical
Exit Sub
End If
'Check, ob gültiges Jahr
If IsNumeric(.Range("J5")) Then 'ausgewähltes Jahr
iJahr = Range("J5")
Else
MsgBox "ausgewähltes Jahr ist ungültig !", vbCritical
Exit Sub
End If
'gültige Kalenderwoche
Set ws_H = Worksheets("Hintergrunddaten")
mKW = WorksheetFunction.Max(ws_H.Range("C3:C54")) - 1
If iKW > mKW Then
MsgBox "Ungültige Kalenderwoche !" & Chr(10) _
& "Maximal zulässig für das Jahr " & iJahr & " ist " & mKW, vbCritical
Exit Sub
End If
'Bereich Kalenderwochen festlegen
erg = Application.Match(mKW + 1, ws_H.Range("C3:C54"), 0) + 2
If Not IsNumeric(erg) Then
MsgBox "Maximale KW in Hintergrunddaten nicht gefunden !", vbCritical
Exit Sub
End If
KW_Bereich = "C" & IIf(ws_H.Range("C3") = 1, 3, 2) & ":C" & erg

'************************************************************************
' Leeren Tagesblätter für ausgewählte und darauffolgende Woche
'************************************************************************
For Each sh In ThisWorkbook.Sheets
Select Case sh.Name
Case "Montag", "Dienstag", "Mittwoch", "Donnerstag", "Freitag", "Samstag" 'ausgewählte Woche
Union(sh.Range("B11:H22"), sh.Range("K11:Q22"), sh.Range("B31:H42"), sh.Range("K31:Q42")).ClearContents
Case "Montag" & sSx, "Dienstag" & sSx, "Mittwoch" & sSx, "Donnerstag" & sSx, "Freitag" & sSx, "Samstag" & sSx 'darauffolgende Woche
Union(sh.Range("B11:H22"), sh.Range("K11:Q22"), sh.Range("B31:H42"), sh.Range("K31:Q42")).ClearContents
End Select
Next sh

'************************************************************************
' Quelldaten zeilenweise auf die Tagesblätter verteilen
'************************************************************************
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For qr = 2 To LoL_Q
KW = WorksheetFunction.WeekNum(.Range("A" & qr), 21) 'Kalenderwoche der aktuellen Position

'Name Wochentag ermitteln
If KW = iKW Or KW = iKW + 1 Then
dName = Format(.Range("A" & qr), "dddd") 'Name Wochentag
If dName = "Sonntag" Then
fDatum = fDatum + 1 'Fehler zählen
.Range("A" & qr).Interior.ColorIndex = 6 'fehlerhaftes Datum markieren
GoTo Weiter
End If

If KW = iKW + 1 Then dName = dName & sSx 'Name Wochentga_2
On Error GoTo Error_handling
Set sh = Worksheets(dName)
On Error GoTo 0

'welche Schichtzeiten sind zu nehmen ?
erg = Application.Match(KW, ws_H.Range(KW_Bereich), 0)
If Not IsNumeric(erg) Then
MsgBox "Kalenderwoche " & KW & " in Blatt Hintergrunddaten nicht gefunden !", vbCritical
Exit Sub
Else
h = erg 'Zeilen# Schichtzeiten für KW
End If

'Ermitteln Koordination für die Zieltabelle
If CDate(.Range("E" & qr)) >= CDate(ws_H.Range("G" & h)) And CDate(.Range("E" & qr)) <= CDate(ws_H.Range("H" & h)) Then
sZeile = 11
zc = 2
ElseIf CDate(.Range("E" & qr)) >= CDate(ws_H.Range("I" & h)) And CDate(.Range("E" & qr)) <= CDate(ws_H.Range("J" & h)) Then
sZeile = 31
zc = 2
ElseIf CDate(.Range("E" & qr)) >= CDate(ws_H.Range("K" & h)) And CDate(.Range("E" & qr)) <= CDate(ws_H.Range("L" & h)) Then
sZeile = 11
zc = 11
ElseIf CDate(.Range("E" & qr)) >= CDate(ws_H.Range("M" & h)) And CDate(.Range("E" & qr)) <= CDate(ws_H.Range("N" & h)) Then
sZeile = 31
zc = 11
Else
fUhrzeit = fUhrzeit + 1 'fehlerhafte Uhrzeit
Range("E" & qr).Interior.ColorIndex = 6 'gelb markieren
GoTo Weiter 'Position nicht verarbeiten
End If

'Ermitteln nächste freie Zeile im Quadranten und speichere dort die Daten
sw = False
For zr = sZeile To sZeile + 11
If sh.Cells(zr, zc) = "" Then
.Range("B" & qr & ":H" & qr).Copy Destination:=sh.Cells(zr, zc)
sw = True
Exit For
End If
Next zr
If sw = False Then
MsgBox "Eintragung Zeile " & qr & Chr(10) _
& "konnte nicht eingefügt werden" & Chr(10) _
& "Tabelle " & dName, vbExclamation
End If
End If
Weiter:
Next qr
End With

Error_handling:
If Err.Number <> 0 Then
MsgBox "Prozedur abgebrochen !" & Chr(10) _
& "Fehler " & Err.Number & " " & Err.Description & Chr(10) _
& "Tabellenblatt " & dName & " fehlt !", vbCritical
Else
MsgBox "Übernahme der Daten ist abgeschlossen !" & Chr(10) _
& "Anzahl Uhrzeit-Fehler " & fUhrzeit & Chr(10) _
& "Anzahl Datum-Fehler: " & fDatum, IIf(fDatum + fUhrzeit = 0, vbInformation, vbExclamation)
End If
On Error GoTo 0
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.Calculate
End Sub

Knutschkugel
17.08.2014, 17:26
Danke für die neue Version, Die Schichtzeiten nimmt er aber noch nicht aus den Hintergrunddaten, oder? Habe mal für den 11.08 ein Termin auf 05:30 geändert und den Schichtstart auf 05:00 geschoben in Hintergrunddaten.

aloys78
17.08.2014, 17:38
Da war noch ein kleiner Fehler.
Führe mal die rot markierte Änderung durch:
'welche Schichtzeiten sind zu nehmen ?
erg = Application.Match(KW, ws_H.Range(KW_Bereich), 0) + 1
If Not IsNumeric(erg) Then
MsgBox "Kalenderwoche " & KW & " in Blatt Hintergrunddaten nicht gefunden !", vbCritical
Exit Sub
Else
h = erg 'Zeilen# Schichtzeiten für KW
End If

'Ermitteln Koordination für die Zieltabelle


VG
Aloys

Knutschkugel
17.08.2014, 20:01
Danke ,
ziehe den Hut vor deiner Hilfe und Leistung,
Werde morgen mal noch etwas probieren.
MfG

Knutschkugel
18.08.2014, 17:43
Hallo,
bin grenzenlos begeistert

So habe heute fleißig Daten eingepflegt und dahingehend auch etwas mehr testen können.

Ist es möglich bestimmte Datums Tage zu sperren so das da keine Termine angelegt werden können? Mit Sonntage klappt ja das die als Fehler gemeldet werden, aber wie ist das mit Feiertagen? gibt es da die Möglichkeit das ich die Feiertage für das betreffende Bundesland in Hintergrunddaten einpflege und er sollte mir ein Termin zb auf dem 25.12.2014 fallen Meldet er mir zu diesem Datum ein Fehler und hebt es Farblich hervor? So das der Termin erst gar nicht eingetragen wird.

MfG

aloys78
18.08.2014, 20:49
Hallo,
Ist es möglich bestimmte Datums Tage zu sperren so das da keine Termine angelegt werden können?

Da sehe ich überhaupt keine Probleme.
Liegt ein Feiertag vor, dann könnte man das Datum zB rot markieren

Ich brauche dazu aber die Feiertagstabelle, die für das jeweilige Bundesland die Feiertage anzeigt.

VG
Aloys

Knutschkugel
18.08.2014, 21:12
Download wieder über Dropbox aufgrund der Datei größe (https://www.dropbox.com/s/hao2vpghadrfbkz/%C3%9Cberarbeitung.xlsm)

Würde die entsprechenden Daten immer in den selben Feldern (Hintergrunddaten) eintragen Plus 2 Zellen nach unten mit einplanen dafür

Danke im vorraus

aloys78
18.08.2014, 21:36
Hallo,
Würde die entsprechenden Daten immer in den selben Feldern (Hintergrunddaten) eintragen Plus 2 Zellen nach unten mit einplanen dafür
Ich kann damit etwas anfangen.

Für dich halte ich das Verfahren aber für sehr aufwendig, da du für jedes Jahr und Bundesland die Daten jeweils manuell eingeben musst.
Man könnte auch einen anderen Ansatz wählen:
- das Jahr steht ja in Eintragungen!J5,
- daraus kann man per Formel den Ostersonntag ermitteln und die beweglichen Feiertage berechnen
- über die Eingabe des Bundeslandes zB in J6 könnte man dann des Weiteren die wenigen Bundesland-abhängigen Feiertage kennzeichnen
- und brauchte dann die Tabelle nicht mehr anzupacken.

VG
Aloys

Knutschkugel
18.08.2014, 21:42
Das Bundesland wäre Brandenburg in diesem Fall

Zum Teil verstehe ich dich was du mir sagen möchtest :-) (kann nur sagen bin auf die Umsetzung gespannt)

Verabschiede mich schon mal für heute

Gute Nacht & Danke

aloys78
19.08.2014, 08:00
Hallo,

anbei einen Vorschlag zum Thema Feiertage und Bundesland, gelöst mit Excel-Formeln. Ich benutze etwas ähnliches und habe es auf deine Bedürfnisse zugeschnitten.
Der VBA-Code ist aber auf die Nicht-Berücksichtigung von Feiertagen noch nicht angepasst.

Version 10 (http://www.file-upload.net/download-9399213/Knutschkugel_--berarbeitung-V-10.xlsm.html)

Was ist geändert ?
Blatt Eintragungen
- Eingabe Bundesland

Blatt Hintergrunddaten ab Zeile 59
- eine Liste der Bundesländer
- Ausgangsdaten für die Feiertagsberechnung
- Feiertagstabelle, gruppiert nach fest, beweglich, BL-bezogen
- in Sp D ein "x", wenn Feiertag anzuwenden ist

Sonntage als Feiertage habe ich bewußt der Vollständigkeit halber drin gelassen. Der Sonntag wird ja schon vor der Feiertagsüberprüfung abgefangen.

Wenn das so aus deiner Sicht ok ist, passe ich dann noch den Code an.

Gruß
Aloys

Knutschkugel
20.08.2014, 06:12
Hallo,
Habe es mal mit deiner Datei getestet. Irgendwas fehlt da noch, er nimmt mir zb den 21.04.2014 noch in KW 17 mit rein als Termin.

Dropbox Download (https://www.dropbox.com/s/z41i56ljsmy9i2i/Knutschkugel_--berarbeitung-V-10.xlsm)

Hallo habe dann denke ich jetzt den letzten änderungswunsch :p

Habe mal unten in den Tab`s ein ein neuen Tab hinzugefügt Dummy_Import
denke Prozess dürfte fast der Selbe sein wie bei den termin nur etwas Komplizierter.
Im Tab Dummy_Import würden immer in Spalte A das Datum stehen in Spalte B Der Frachtführer und in Spalte C die Zahlen.

Im Tab Dummy_Werte würden
die Spalten C-L Die Frachtführer enthalten in Zeile 4
Die Spalte B enthält das Datum
Hier müsste dann auch der neue Button würde das getrennt von anderen laufen lassen.

ist es hier möglich mittels seperater VBA nur die Werte zu übertragen (überkreuzvergleich passt Datum und Frachtführer zusammen trage ich die Werte ein = Tabellenformat bleibt vorhanden er nimmt wirklich nur die Werte und Überschreibt sie)

oder Stoßen wir jetzt endlich an die grenzen von Excel ?

Die Suche hat zu dem Thema leider nix gebracht mit Überkreuz

Danke schonmal vorab

aloys78
20.08.2014, 06:16
Guten Morgen,
Wenn das so aus deiner Sicht ok ist, passe ich dann noch den Code an.
Da ich von dir in der Zwischenzeit nichts mehr gehört habe, unterstelle ich, dass der Lösungsvorschlag zu den Feiertagen deine Zustimmung gefunden hat.

Den passenden Code habe ich jetzt beigefügt:
Option Explicit

'=======================================================================
' Version 10.2 vom 20.08.2014
'=======================================================================

Private Sub CommandButton1_Click()
'=======================================================================
' Update Tagesblätter
'=======================================================================
Dim qr As Long 'Zeilen# in Quelltabelle
Dim qc As Long 'Spalten# in Quelltabelle
Dim zr As Long 'Zeilen# in Zieltabelle
Dim zc As Long 'Spalten# in Zieltabelle
Dim z As Long 'Zeilen#
Dim LoL_Q As Long 'Letzte Zeile Quelldatei darauffolgende Woche
Dim sh As Worksheet 'Sheet-Name ausgewählte Woche
Dim ws_H As Worksheet 'Sheet Hintergrunddaten
Dim h As Long 'Zeilen# Hintergrunddaten
Dim dName As String 'Dateiname
Dim KW As Double 'Kalenderwoche der aktuellen Position
Dim erg As Variant 'Egebnis Match-Operation
Dim iJahr As Integer 'Jahr für Datenauswahl
Dim iKW As Integer 'KW für Datenauswahl
Dim mKW As Integer 'maximal mögliche KW
Dim sZeile As Long 'Start-Zeile im Quadranten
Dim fDatum As Long 'Anzahl Datum-Fehler
Dim fUhrzeit As Long 'Anzahl Uhrzeit Fehler
Dim KW_Bereich As String 'Bereich Kalenderwochen in Hintergrunddaten
Dim sw As Boolean
Const sSx As String = "_2" 'Suffix Dateinamen darauffolgende Woche

'************************************************************************
' prüfe Plausibilität Vergleichswerte
'************************************************************************
With ActiveSheet
'Initialisieren Werte
LoL_Q = .Cells(Rows.Count, "B").End(xlUp).Row 'Letzte Datenzeile
.Range("A2:A" & LoL_Q).Interior.ColorIndex = xlNone 'eventuell vorhandene farbliche Markierung Datum entfernen
.Range("E2:E" & LoL_Q).Interior.ColorIndex = xlNone 'eventuell vorhandene farbliche Markierung Uhrzeit entfernen
iKW = .Range("J8") 'ausgewählte KW
'check, ob Eingabedaten vorhanden
If LoL_Q < 2 Then
MsgBox "Keine Daten im Tabellenblatt !", vbCritical
Exit Sub
End If
'Check, ob gültiges Jahr
If IsNumeric(.Range("J5")) Then 'ausgewähltes Jahr
iJahr = Range("J5")
Else
MsgBox "ausgewähltes Jahr ist ungültig !", vbCritical
Exit Sub
End If
'gültige Kalenderwoche
Set ws_H = Worksheets("Hintergrunddaten")
mKW = WorksheetFunction.Max(ws_H.Range("C3:C54")) - 1 'maximal erlaubte KW
If iKW > mKW Then
MsgBox "Ungültige Kalenderwoche !" & Chr(10) _
& "Maximal zulässig für das Jahr " & iJahr & " ist " & mKW, vbCritical
Exit Sub
End If
'Bereich Kalenderwochen festlegen
erg = Application.Match(mKW + 1, ws_H.Range("C3:C54"), 0) + 2
If Not IsNumeric(erg) Then
MsgBox "Maximale KW in Hintergrunddaten nicht gefunden !", vbCritical
Exit Sub
End If
KW_Bereich = "C" & IIf(ws_H.Range("C3") = 1, 3, 2) & ":C" & erg 'Adresse KW-Bereich

'************************************************************************
' Leeren Tagesblätter für ausgewählte und darauffolgende Woche
'************************************************************************
For Each sh In ThisWorkbook.Sheets
Select Case sh.Name
Case "Montag", "Dienstag", "Mittwoch", "Donnerstag", "Freitag", "Samstag" 'ausgewählte Woche
Union(sh.Range("B11:H22"), sh.Range("K11:Q22"), sh.Range("B31:H42"), sh.Range("K31:Q42")).ClearContents
Case "Montag" & sSx, "Dienstag" & sSx, "Mittwoch" & sSx, "Donnerstag" & sSx, "Freitag" & sSx, "Samstag" & sSx 'darauffolgende Woche
Union(sh.Range("B11:H22"), sh.Range("K11:Q22"), sh.Range("B31:H42"), sh.Range("K31:Q42")).ClearContents
End Select
Next sh

'************************************************************************
' Quelldaten zeilenweise auf die Tagesblätter verteilen
'************************************************************************
Application.ScreenUpdating = False 'Bildschirm-Update temporär unterdrücken
Application.Calculation = xlCalculationManual 'Automatisches Berechnen ausschalten

For qr = 2 To LoL_Q 'Schleife über alle Positionen in 'Eintragungen'
KW = WorksheetFunction.WeekNum(.Range("A" & qr), 21) 'Kalenderwoche der aktuellen Position

'Name Wochentag ermitteln und Sonntags-Positionen aussortieren
If KW = iKW Or KW = iKW + 1 Then 'nur lfd. und darauffolgende KW sind hier relevant
dName = Format(.Range("A" & qr), "dddd") 'Name Wochentag
If dName = "Sonntag" Then 'dieser Wochentag ist ungültig
fDatum = fDatum + 1 'falsche Wochentage zählen
.Range("A" & qr).Interior.ColorIndex = 6 'fehlerhaftes Datum markieren
GoTo Weiter
End If

'Feiertage werden ebenfalls aussortiert
erg = Application.Match(.Range("A" & qr), ws_H.Range("A85:A109"), 0) 'Datum in Feiertagstabelle suchen
If IsNumeric(erg) Then
If ws_H.Range("D" & 84 + erg) = "x" Then
.Range("A" & qr).Interior.ColorIndex = 3 'wenn Feiertag - dann Datum rot markieren
fDatum = fDatum + 1
GoTo Weiter
End If
End If

'Datenblatt für die dem Datum entsprechende KW zuordnen
If KW = iKW + 1 Then dName = dName & sSx 'Name Wochentag_2
On Error GoTo Error_handling
Set sh = Worksheets(dName)
On Error GoTo 0

'welche Schichtzeiten sind zu nehmen ?
erg = Application.Match(KW, ws_H.Range(KW_Bereich), 0) + 1 'Suche KW in 'Hintergrunddaten'
If Not IsNumeric(erg) Then
MsgBox "Kalenderwoche " & KW & " in Blatt Hintergrunddaten nicht gefunden !", vbCritical
Exit Sub
Else
h = erg 'Zeilen# Schichtzeiten für KW
End If

'Ermitteln Koordinaten für die Zieltabelle
If CDate(.Range("E" & qr)) >= CDate(ws_H.Range("G" & h)) And CDate(.Range("E" & qr)) <= CDate(ws_H.Range("H" & h)) Then
sZeile = 11 'Frühschicht vor der Pause
zc = 2
ElseIf CDate(.Range("E" & qr)) >= CDate(ws_H.Range("I" & h)) And CDate(.Range("E" & qr)) <= CDate(ws_H.Range("J" & h)) Then
sZeile = 31 'Frühschicht nach der Pause
zc = 2
ElseIf CDate(.Range("E" & qr)) >= CDate(ws_H.Range("K" & h)) And CDate(.Range("E" & qr)) <= CDate(ws_H.Range("L" & h)) Then
sZeile = 11 'Spätschicht vor der Pause
zc = 11
ElseIf CDate(.Range("E" & qr)) >= CDate(ws_H.Range("M" & h)) And CDate(.Range("E" & qr)) <= CDate(ws_H.Range("N" & h)) Then
sZeile = 31 'Spätschicht nach der Pause
zc = 11
Else
fUhrzeit = fUhrzeit + 1 'fehlerhafte Uhrzeit (liegt außerhalb aller Schichtzeiten)
Range("E" & qr).Interior.ColorIndex = 6 'Uhrzeit gelb markieren
GoTo Weiter 'Position nicht verarbeiten
End If

'Ermitteln nächste freie Zeile im Schichtzeiten-Quadranten und speichere dort die Daten
sw = False
For zr = sZeile To sZeile + 11 'Schleife zur Suche der nächsten freien Zeile
If sh.Cells(zr, zc) = "" Then
.Range("B" & qr & ":H" & qr).Copy Destination:=sh.Cells(zr, zc) 'Datenzeile komplett übertragen
sw = True
Exit For
End If
Next zr

'Zeile aus 'Eintragungen' konnte nicht bei zugehöriger Schicht gespeichert werden
If sw = False Then
MsgBox "Eintragung Zeile " & qr & Chr(10) _
& "konnte nicht eingefügt werden" & Chr(10) _
& "Tabelle " & dName, vbExclamation
End If
End If
Weiter:
Next qr
End With

' Fehlerbehandlung
Error_handling:
If Err.Number <> 0 Then
MsgBox "Prozedur abgebrochen !" & Chr(10) _
& "Fehler " & Err.Number & " " & Err.Description & Chr(10) _
& "Tabellenblatt " & dName & " fehlt !", vbCritical
Else
MsgBox "Übernahme der Daten ist abgeschlossen !" & Chr(10) _
& "Anzahl Uhrzeit-Fehler " & fUhrzeit & Chr(10) _
& "Anzahl Datum-Fehler: " & fDatum, IIf(fDatum + fUhrzeit = 0, vbInformation, vbExclamation)
End If

'Abschluss-Arbeiten
On Error GoTo 0 'Standard für Fehlerbehandlung aktivieren
Application.ScreenUpdating = True 'Bildschirm-Update wieder aktivieren
Application.Calculation = xlCalculationAutomatic 'Automatisches Rechnen wieder einschalten
Application.Calculate 'Neuberechnung durchführen
End Sub


VG
Aloys

Knutschkugel
20.08.2014, 14:25
Hallo,
Ja hat meine Zustimmung gefunden, hatte die Zeile dahingehend irgendwie überlesen.
Hast du das gesehen von mir um 07:12?
Danke für den neuen Code funktioniert perfekt

aloys78
20.08.2014, 16:20
Hallo,

als erstes fällt mir an der Datei V10 auf, dass sie noch die alte Makro-Version 9 enthält.
Danke für den neuen Code funktioniert perfekt
Kann ich dann die Aussage von 7:12 Uhr heute morgen vergessen ?
Außerdem gehört nach meiner Tabelle der 21.4. wirklich zur KW 17.
oder Stoßen wir jetzt endlich an die grenzen von Excel ?
Wieso endlich ?
Aus meiner Sicht sind diese Grenzen noch nicht einmal in Sicht.
Allerdings ist deine Beschreibung zu den Dummy-Werten noch nicht so, dass man sofort "in die Hände spucken könnte" und sich an die Lösung zu machen.
Zum Beispiel:
- was ist in Zeile 4 der Unterschied zwischen Frachtführer klein und groß ?
- kommen die P-Werte aus Dummy-Import Sp C ?
- woher kommen die VF- und die LP-Werte
- sind in Zeile 4 alle Frachtführer aufgeführt ?

Und verstehe ich es richtig, dass es in der Aufgabenstelllung "nur" darum geht, die Werte aus Dummy-Import jeweils in Dummy-Werten in der Zelle mit den Koordination Datum und Frachführer abzulegen.

VG
Aloys

Knutschkugel
20.08.2014, 17:09
Hallo,
-wie meinst du das mit dem Zeile 4 Frachtführer Unterschied?
-JA die P-Werte kommen immer aus Sp C
-Die Werte VF und LP werden momentan von Hand von vorn nach hinten geschrieben was ein ziemlicher Zeitaufwand ist (die VF und LP Werte könnten im Grunde nach Vergabe richtiger Aktueller Zahlen Importiert werden aus dem Tab "Einträge" sobald im Feld Termin nur noch Zahlen drin stehen, habe es momentan so gelöst das die Dummy werte als Termin Code den Frachtführer Code haben plus eine 3 stellige Zahl.(Siehe Anhang) Sprich stehen keine Buchstaben mehr in der Spalte Termin könnte er auch die Werte VF & LP von da übernehmen um auch diese noch zu ergänzen)
-in Zeile 4 sind alle Frachtführer aufgeführt für die ich Dummy werte brauche (es gibt auch welche die liefern nur 1-2 mal Jährlich an die sind da natürlich nicht enthalten)

MfG

Und nochmal riesen Dank für deine Mühe

aloys78
20.08.2014, 17:49
Hallo Knutschkugel,

bei mir ist jetzt angekommen:

in Dummy-Werte werden für Frachtführer (Klein) die Daten aus Dummy-Import übernommen;
Hierfür schlage ich einen CommanButton in Dummy-Werte vor.
Die Werte VF und LP für Frachtführer (groß) werden aus Datenblatt Eintragungen übernommen, wenn in diesem Blatt unter Spalte Termin eine Zahl steht;
die Aktualiserung könnte durch einen weiteren Button in Dummy-Werte oder automatisch beim Aktivieren des Blattes erfolgen.


In diesem Zusammenhang könntest du eine neue Datei mit mehr Testdaten in Eintragungen für die Übernahme von VF/LP schicken !

Gibt es bezüglich des 21.4. noch eine Unklarheit ?

VG
Aloys

Knutschkugel
20.08.2014, 18:46
Abend,
nein bezüglich des 21.04. gibt es keine Unklarheiten (Funktioniert einwandfrei)
für die Aktualisierung der FV & LP Daten wäre ich persönlich für den Dummy Button so findet die Aktualisierung dann statt wenn ich es möchte und nicht sobald ich die Seite aufrufe
im Anhang befindet sich eine Datei mit Testdaten ca. 100 Zeilen hoffe des reicht für kleinen Test ?

Gruß

aloys78
20.08.2014, 18:52
Hallo,
im Anhang befindet sich eine Datei mit Testdaten ca. 100 Zeilen hoffe des reicht für kleinen Test ?
Das reicht ! Aber wo ist der Anhang ?

VG
Aloys

Knutschkugel
20.08.2014, 18:56
Dropbox Download (https://www.dropbox.com/s/z41i56ljsmy9i2i/Knutschkugel_--berarbeitung-V-10.xlsm)
Die Datei war zu groß deswegen gab es kein Anhang ^^

Knutschkugel
21.08.2014, 06:00
Sollte ich mit Montag_3-Samstag_3 noch zusätzlich arbeiten wollen welche stellen des Code müsste ich ändern?

aloys78
21.08.2014, 06:47
Guten Morgen,

anbei eine neue Version für die Lösung der Aufgabenstellung um das Blatt Dummy_Werte.

Version 12.1 (http://www.file-upload.net/download-9409174/Knutschkugel_--berarbeitung-V-12.1.xlsm.html)
Sollte ich mit Montag_3-Samstag_3 noch zusätzlich arbeiten wollen welche stellen des Code müsste ich ändern?

Da gab es einmal einen Film "Unendliche Geschichte". :)

Und kann es auch noch Woche 4 und weitere geben; alles kein Problem. Aber wichtig zu wissen für eine Code-Anpassung.
Denn es fing mit einer Woche an; die Erweiterung um die darauffolgende Woche wurde dann einfach angefügt. Wenn eine generelle Lösung für n Wochen gefordert ist, kann man den Code von vornherein viel anpassungsfreundlicher gestalten.

Zum weiteren Vorgehen schlage ich vor, du testest erst mal den neuen Teil für System-Werte der Version 12.1

Da ich deine VBA-Kenntnisse nicht einschätzen kann, sehe ich im Folgenden dann folgende Möglichkeiten:

du traust dir die Änderungen zu, dann müßtest du das auch alleine schaffen,
du würdest es gerne allein probieren; dann ändere doch den Code, markiere die Änderungen und ich schaue noch mal drüber
ich überarbeite den Code so, dass du dann frei wählen kannst, ob du mit 1, 2, 3 oder n Wochen arbeiten kannst.

VG
Aloys

Knutschkugel
21.08.2014, 08:09
Hallo,
Leider sind meine VBA-Kenntnisse gleich null, ich schaue mir dein Code an und kann bei bedarf selber die Spalten bzw Zeilen ändern aber für mehr reicht es leider nicht


das Aktualisieren klappt soweit, doch leider löscht er mir auch alle Dummy Werte gleich mit (da wo noch Buschstaben mit im Termin drin stehen), das was nicht passieren sollte
Das passiert bei Klein wie Groß

zu Klein:
hier soll nur das Aktualiesiert werden wo das Datum auch übereinstimmt alle anderen Felder sollen so bleiben wie sie sind.

zu Groß:
hier soll nur Aktualisiert werden wo unter Termin keine Buchstaben mehr im Feld mit drin stehen zu dem Entsprechendem Datum natürlich zusortiert...

Danke

aloys78
21.08.2014, 08:37
Hallo Knutschkugel,

das war ja ein schnelles Feedback.

Erweiterung auf Montag_3 etc
Dann passe ich den Code an, und du kannst dann drüber schauen, was sich geändert hat.

Dummy-Werte
Folgendes habe ich verstanden:

Zu Klein:
- es wird grundsätzlich nichts gelöscht
- nur bei Übereinstimmung des Datums wird beim Frachtführer der vorhandene Wert ersetzt

Zu Groß
- es wird grundsätzlich nichts gelöscht
- wenn Termin in Eintragungen numerisch ist, werden beim betreffenden Datum VF und LP beim Frachtführer geändert.

Weiteres Vorgehen
Schritt 1: Korrektur Dummy-Werte Verfahren (frühestens heute Abend)
Schritt 2: Ausdehnung auf Montag_n

VG
Gruß

Knutschkugel
21.08.2014, 08:58
Hallo,
Löschen ist falsch ausgedrückt er ersetzt die Zahl durch eine 0
Somit habe ich dann leider keine "Dummy" werte mehr

Nachtrag:
wie kann mann das Lösen das falls an einen Tag der Frachtführer mehrmals kommthat er ja mehrere Terminnummern, ist es möglich das er diese dann auch addiert bzw makiert das man das noch von Hand machen kann?

aloys78
21.08.2014, 13:17
Hallo,
Löschen ist falsch ausgedrückt er ersetzt die Zahl durch eine 0
Somit habe ich dann leider keine "Dummy" werte mehr
Dafür anbei die neue Version; sie löst noch nicht das Problem Montag_n
Das ging jetzt doch schneller. Es war nicht viel zu ändern, aber ich habe es nicht getestet.

wie kann mann das Lösen das falls an einen Tag der Frachtführer mehrmals kommthat er ja mehrere Terminnummern, ist es möglich das er diese dann auch addiert bzw makiert
Verstehe ich das richtig ?
Für ein Datum x gibt es für einen Frachtführer mehrere Termine.
- für die Wochentagsauswertung werden diese Positionen nachwievor getrennt gespeichert
- für die Dummy-Werte erfolgt eine Kumulierung der Werte über alle Termine, die numerisch sind.

Gruß
Aloys

Option Explicit

'Version 14 vom 21.08.2014

Private Sub CommandButton1_Click()
'=====================================================================
' Aktualisieren Frachtfüher (Klein) mit 'Dummy-Import'
'=====================================================================
Dim q As Long 'Zeilen# Dummy-Import = Quell-Tabelle
Dim z As Long 'Zeilen# Dummy_Werte = Ziel-Tabelle
Dim c As Long 'Spalten#Ziel-Tabelle
Dim LoL As Long 'letzte Zeile Ziel-Tabelle
Dim ws_Q As Worksheet 'Quell-Tabelle
Dim erg As Variant 'Ergebnis Match

'Initialisieren
LoL = Cells(Rows.Count, "B").End(xlUp).Row

'Koordinaten Ziel-Tabelle suchen
Set ws_Q = Worksheets("Dummy_Import")
With ws_Q
For q = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
erg = Application.Match(.Range("A" & q), Range("B6:B" & LoL), 0) 'Suche Datum
If IsNumeric(erg) Then
z = erg + 5 'Zeilen#
erg = Application.Match(.Range("B" & q), Range("C4:K4"), 0) 'Suche Frachtführer
If IsNumeric(erg) Then
c = erg + 2 'Spalten#
Cells(z, c) = .Range("C" & q)
End If
End If
Next q
End With
End Sub


Private Sub CommandButton2_Click()
'=====================================================================
' Aktualisieren Frachtführer (Groß) mit Daten aus 'Eintragungen'
'=====================================================================
Dim q As Long 'Zeilen# Eintragungen = Quell-Tabelle
Dim z As Long 'Zeilen# Dummy_Werte = Ziel-Tabelle
Dim c As Long 'Spalten#Ziel-Tabelle
Dim LoL As Long 'letzte Zeile Ziel-Tabelle
Dim ws_Q As Worksheet 'Quell-Tabelle
Dim erg As Variant 'Ergebnis Match

'Initialisieren
LoL = Cells(Rows.Count, "B").End(xlUp).Row

'Koordinaten Ziel-Tabelle suchen
Set ws_Q = Worksheets("Eintragungen")
With ws_Q
For q = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
If IsNumeric(.Range("B" & q)) Then
erg = Application.Match(.Range("A" & q), Range("B6:B" & LoL), 0) 'Suche Datum
If IsNumeric(erg) Then
z = erg + 5 'Zeilen#
erg = Application.Match(.Range("D" & q), Range("L4:W4"), 0) 'Suche Frachtführer
If IsNumeric(erg) Then
c = erg + 11 'Spalten#
Cells(z, c) = .Range("F" & q) 'VF
Cells(z, c + 1) = .Range("G" & q) 'LP
End If
End If
End If
Next q
End With
End Sub

Knutschkugel
22.08.2014, 05:56
Verstehe ich das richtig ?
Für ein Datum x gibt es für einen Frachtführer mehrere Termine.
- für die Wochentagsauswertung werden diese Positionen nachwievor getrennt gespeichert
- für die Dummy-Werte erfolgt eine Kumulierung der Werte über alle Termine, die numerisch sind.

ja es kann durchaus Tage geben wo der Frachtführer 2 mal kommt oder gar 3 mal.

ist dies der Fall zieht er zu diesen Datum leider gar keine Daten für den Dummy Tab. Wäre es möglich das die Zahlen / Felder die er dahingehend nicht verarbeiten kann Farblich hervorhebt ?

aloys78
22.08.2014, 06:49
Hallo,
ja es kann durchaus Tage geben wo der Frachtführer 2 mal kommt oder gar 3 mal.
ist dies der Fall zieht er zu diesen Datum leider gar keine Daten für den Dummy Tab
So wie ich es sehe, wird jeweils die letzte Position in Dummy-Werte angezeigt, weil die vorhergehenden überschrieben wurden.
Möglichkeiten:
- alle Positionen kumulieren, wie von mir schon vorgeschlagen
- eine bestimmte Position übernehmen (die erste, die letzte oder die mit den höchsten Werten und die anderen markieren)

Gruß
Aloys

Knutschkugel
22.08.2014, 06:52
Würde das kumulieren bevorzugen ;-)

aloys78
23.08.2014, 06:03
Guten Morgen,
Würde das kumulieren bevorzugen
Nachstehend eine neue Code-Version für Dummy_Werte, getestet jeweils mit Daten vom 8.8. (Eintragungen und Dummy_Import).
Dabei fielen mir 2 Besonderheiten auf, die beim Testen irritieren.

Frachtführer Klein
- vermutlich sind hier die Frachtführer noch nicht ganz gleich benamt, zB TOFLX (Import) und 1TOFP (Werte), oder sind das doch unterschiedliche ?

Frachtführer Groß
- hier liegen bei VF und LP in Werte noch Formeln vor (zB unter SCHEN und BOOXG)

VG
Aloys

Option Explicit
'=====================================================================
' Version 14.6 vom 23.08.2014
'=====================================================================

'=====================================================================
' Konstanten für beide Prozeduren
'=====================================================================
Const cParcel_u As Integer = 3 'Spalte 1. Frachtführer kien
Const cParcel_o As Integer = 12 'Spalte letzter Frachtführer klein
Const cCarrier_u As Integer = 13 'Spalte VF für 1. Frachtführer groß
Const cCarrier_o As Integer = 23 'spalte VF für letzten Frachtführer groß
Const cLookAt As String = "xlPart" 'xlPart = Teilausdruck, xlWhole = volle Übereinstimmung (z Zt nicht genutzt)

'=====================================================================
' Variable, die in beiden Prozeduren verwendet werden
'=====================================================================
Dim q As Long 'Zeilen# Dummy-Import = Quell-Tabelle
Dim z As Long 'Zeilen# Dummy_Werte = Ziel-Tabelle
Dim c As Long 'Spalten#Ziel-Tabelle
Dim LoL As Long 'letzte Zeile Ziel-Tabelle
Dim ws_Q As Worksheet 'Quell-Tabelle
Dim erg As Variant 'Ergebnis Match
Dim Zelle As Range 'Ergebnis Find


Private Sub CommandButton1_Click()
'=====================================================================
' Aktualisieren Frachtfüher (Klein) mit 'Dummy-Import')
' Die Positionen in 'Dummy_Import' werden zeilenweise verarbeitet.
' Datum und Frachtführer sind die Koordinaten für Dummy_Werte;
' in diese Zelle wird der Wert aus Dummy-Import kopiert.
' Alle übrigen Zellen in Dummy_Werte bleiben unverändert.
'=====================================================================
'Initialisieren
LoL = Cells(Rows.Count, "B").End(xlUp).Row 'Letzte Zeile in Dummy_Werte

'Koordinaten Ziel-Tabelle suchen und danach Wert aus Dummy_Import speichern
Set ws_Q = Worksheets("Dummy_Import")
With ws_Q
For q = 1 To .Cells(Rows.Count, "A").End(xlUp).Row 'von der 1. bis zur letzten Zeile in Dummy_Import
erg = Application.Match(.Range("A" & q), Range("B6:B" & LoL), 0) 'Suche Datum aus 'Dummy_Import' in 'Dummy_Werte'
If IsNumeric(erg) Then
z = erg + 5 'Zeilen# in Dummy_werte
Set Zelle = Range(Cells(4, cParcel_u), Cells(4, cParcel_o)).Find(.Range("B" & q), LookIn:=xlValues, LookAt:=xlWhole) 'Suche Frachtführer
If Not Zelle Is Nothing Then 'Frachtführer gefunden
c = Zelle.Column 'Spalten# in Dummy-Werte
Cells(z, c) = .Range("C" & q) 'Wert aus Dummy_Import nach Dummy_Werte kopieren
End If
End If
Next q
End With
End Sub


Private Sub CommandButton2_Click()
'=====================================================================
' Aktualisieren Frachtführer (Groß) mit Daten aus 'Eintragungen'
' Die Positionen in 'Eintragungen' werden zeilenweise verarbeitet,
' soweit Termin numerisch ist.
' Datum und Frachtführer sind die Koordinaten für Dummy_Werte.
' Für jede Ziel-Zelle kann es mehrere Positionen geben; deren Werde
' VF und LP werden kumuliert.
' Bei der ersten Position für eine Ziel-Zelle werden die Daten in die
' Ziel-Zelle kopiert, die nächsten Positionen addieren dann die Werte.
' Die Steuerung erfolgt über Array, in dem pro Koordination-Kombinlation
' ein Feld vorgesehen ist.
' Kumulierte Werden werden farblich markiert.
' Alle übrigen Zellen in Dummy_Werte bleiben unverändert.
'=====================================================================
Dim arr() 'Array zur Steuerung bei Kumulation der Werte
Dim y As Long 'Index 2 arr

'Initialisieren
LoL = Cells(Rows.Count, "B").End(xlUp).Row 'Letzte Zeile Datum in Dummy_Werte
Range(Cells(6, cCarrier_u), Cells(LoL, cCarrier_o + 1)).Interior.ColorIndex = xlNone 'Farbe bei kumulierten Werten entfernen
y = (cCarrier_o - cCarrier_u) / 2 + 1 'Anzahl Frachtführer Groß
ReDim arr(1 To LoL, 1 To y) 'Array mit je einem Feld für die Kombination Datum / Frachtführer
Application.ScreenUpdating = False

'Koordinaten Ziel-Tabelle suchen, Wert speichern bzw kumulieren
Set ws_Q = Worksheets("Eintragungen") 'Quell-Tabelle
With ws_Q
For q = 2 To .Cells(Rows.Count, "A").End(xlUp).Row 'Datum-Werte von der 2. bis zur letzten Zeile in Eintragungen
If IsNumeric(.Range("B" & q)) Then 'nur wenn Termin numerisch ist
erg = Application.Match(.Range("A" & q), Range("B6:B" & LoL), 0) 'Suche Datum in Dummy_Werte
If IsNumeric(erg) Then 'Treffer
z = erg + 5 'Zeilen# Frachtführer in Dummy_Werte
erg = Application.Match(.Range("D" & q), Range(Cells(4, cCarrier_u), Cells(4, cCarrier_o)), 0) 'Suche nun Frachtführer
If IsNumeric(erg) Then 'Frachtführer gefunden
c = erg + cParcel_o 'Spalten# Frachtführer in Dummy_Werte
y = (c - cCarrier_u) / 2 + 1 'Nummer aktueller Carrier
If arr(z, y) = "" Then 'für diese Koordinaten Datum /Frachtführer lagen bisher keine neuen Werte vor
'Zeile wurde noch nicht bearbeitet, die Werte überschreiben die vorhandenen
Cells(z, c) = .Range("F" & q) 'VF
Cells(z, c + 1) = .Range("G" & q) 'LP
arr(z, y) = 1 'Flag für Kumulierung setzen
Else
'zweite und jede weitere Position, die neuen Werte sind zu addieren, das Ergebnis ist farblich zu markieren
Cells(z, c) = Cells(z, c) + .Range("F" & q) 'VF kumukieren
Cells(z, c + 1) = Cells(z, c + 1) + .Range("G" & q) 'LP kumulieren
Range(Cells(z, c), Cells(z, c + 1)).Interior.ColorIndex = 6 'Werte VF / LP farblich markieren als kumuliert
End If
End If
End If
End If
Next q
End With

'Abschlussarbeiten
Application.ScreenUpdating = True
End Sub

Knutschkugel
23.08.2014, 09:12
Hallo aloys,
ja bei Frachtführer Klein ist dies richtig da stimmen die Import Daten nicht und müssen manuel geändert werden (ist aber kein Problem)

Bei Frachtführer Groß mit Formeln ist Richtig in Dummy Feld da ermir aus den Letzten 3 Wochen den Mittelwert immer Bildet


Werde dann mich mal ans testen machen

Wünsche ein schönen Tag und schönes Wochenende auf jeden fall schonmal vorab

Gruß

Knutschkugel
02.09.2014, 21:03
Hallo aloy78,

hast du zufällig den angepassten Code? Oder habe ich ihn Übersehen? Würde gerne auf jeden Fall eine dritte Woche hinzufügen wollen.

Das Arbeiten mit der Datei Funktioniert herrvorragend und macht sehr vie Spaß, riesen Dank dafür nochmal


MfG
Martin

...
Dann passe ich den Code an, und du kannst dann drüber schauen, was sich geändert hat.
...

aloys78
02.09.2014, 23:16
Hallo Martin,
Das Arbeiten mit der Datei Funktioniert herrvorragend und macht sehr vie Spaß, ....
Das freut mich zu hören.
hast du zufällig den angepassten Code?
Ja, den habe ich - allerdings noch ungetestet.
Ich hatte dir ein Vorgehen in 2 Schritten vorgeschlagen
Weiteres Vorgehen
Schritt 1: Korrektur Dummy-Werte Verfahren
Schritt 2: Ausdehnung auf Montag_n
Den Code zu Schritt 1 hast du am 23.8. erhalten; das Feedback hat mich heute erreicht.
Für Schritt 2 brauche ich jetzt eine neue Datei mit 3 Wochen, damit ich den Code testen kann.

VG
Aloys

Knutschkugel
02.09.2014, 23:24
Mit den Dummywerten passt es so weit jetzt eigentlich, habe da jetzt nichts schlimmes festgestellt, ein update der Datei gibt es morgen früh dann, danke schon mal voraus

aloys78
14.09.2014, 08:07
Hallo Martin,

anbei den Code für die Erweiterung auf 3 Wochen. Die Anzahl der Auswertungswochen wird durch die Konstante nKW gesteuert, dh du kannst die Auswertung problemlos auf 4 oder 5 Wochen ausdehnen. Es wird aber dabei vorausgesetzt, dass die Ziel-Tabellen Montag_x etc vorhanden sind.

VG
Aloys
Option Explicit

'=============================================================================== ==
' Version 16.2 vom 14.09.2014
'=============================================================================== ==

Private Sub CommandButton1_Click()
'=============================================================================== ==
' Update Tagesblätter
' Auslöser:
' CommandButton 'Update Tagesblätter' im Blatt 'Eintragungen'
' Input
' Daten in den Sp A - H des Blattes 'Eintragungen' = Quell-Daten
' Blatt 'Hintergrunddadten'
' - Max. erlaubte KW
' - Zuordung Datum zu KW
' - Schichtzeiten je KW
' aktuelles Jahr in J5
' Kalenderwoche in J8
' Bundesland in J10
' Steuerungsgrößen
' Konstante nKW - Anzahl Wochen mit Mo bis Sa beginnend
' ab ausgewählter KW
' Konstante sw_nKW - Schalter zur Erzwingung der in nKW
' genannten Anzahl Ziel-Wochen
' Verarbeitung
' Prüfung Eingabe-Parameter
' Ermitteln maximal zulässige KW
' Entfernen Farbmarkierungen in Quell-Tabelle
' Ziel-Tabellen in Grundstellung
' zeilenweise Verarbeitung aller Quell-Zeilen
' - Auswahl über Bundesland und KW (KW und durch nKW definierte Folge-KW)
' - Prüfen, ob Datum gültig ist
' - prüfen, ob Uhrzeit in den vorgegebenen Grenzen liegt
' - Ermitteln Koordinaten des Schicht-Blockes im Ziel-Blatt
' - Check, ob Daten noch in den Zielblock passen
' - Speichern ausgewählte Quell-Daten im zugehörigen Schichtblock
' - Markierung Quelldaten bei Fehlern
' Datum - Datum fehlerhaft (Sonntag) - gelb
' Datum - Datum ist Feiertag - rot
' Uhrzeit - Uhrzeit außerhalb Zeit-Bereichen - gelb
' ISA - Position kann aus Platzmangel
' nicht eingefügt werden - gelb
'=============================================================================== ==
Dim qr As Long 'Zeilen# in Quelltabelle
Dim qc As Long 'Spalten# in Quelltabelle
Dim zr As Long 'Zeilen# in Zieltabelle
Dim zc As Long 'Spalten# in Zieltabelle
Dim z As Long 'Zeilen#
Dim i As Integer 'Schleifenzähler
Dim w As Integer 'Schleifenzähler
Dim LoL_Q As Long 'Letzte Zeile Quelldatei darauffolgende Woche
Dim sh As Worksheet 'Sheet-Name ausgewählte Woche
Dim ws_H As Worksheet 'Sheet Hintergrunddaten
Dim h As Long 'Zeilen# Hintergrunddaten
Dim dName As String 'Dateiname
Dim arr_WT() 'Array Wochentage
Dim KW As Double 'Kalenderwoche der aktuellen Position
Dim erg As Variant 'Egebnis Match-Operation
Dim iJahr As Integer 'Jahr für Datenauswahl
Dim iKW As Integer 'KW für Datenauswahl
Dim mKW As Integer 'maximal mögliche KW
Dim sZeile As Long 'Start-Zeile im Quadranten
Dim fDatum As Long 'Anzahl Datum-Fehler
Dim fUhrzeit As Long 'Anzahl Uhrzeit Fehler
Dim fInsert As Long 'Anzahl Einfüge-Fehler
Dim KW_Bereich As String 'Bereich Kalenderwochen in Hintergrunddaten
Dim sw As Boolean 'Schalter: wenn sw = False, Zeile aus 'Eintragungen' konnte nicht eingefügt werden
Dim sSx As String 'Suffix Dateinamen darauffolgende Woche

Const nKW As Integer = 3 'Anzahl auszuwertende KW (laufende Woche plus Zusatzwochen) '<--- ggf ändern !
Const sw_nKW As Boolean = True 'Schalter: wenn sw_nKW = True, nKW bei Prüfung der eingegebenen KW berücksichtigen '<--- ggf ändern !
' sw_nKW = False, KW bis einschließich mKW möglich

'************************************************************************
' prüfe Plausibilität Vergleichswerte
'************************************************************************
With ActiveSheet
'Initialisieren Werte
LoL_Q = .Cells(Rows.Count, "B").End(xlUp).Row 'Letzte Datenzeile
.Range("A2:A" & LoL_Q).Interior.ColorIndex = xlNone 'eventuell vorhandene farbliche Markierung Datum entfernen
.Range("E2:E" & LoL_Q).Interior.ColorIndex = xlNone 'eventuell vorhandene farbliche Markierung Uhrzeit entfernen
iKW = .Range("J8") 'ausgewählte KW

'check, ob Eingabedaten vorhanden
If LoL_Q < 2 Then
MsgBox "Keine Daten im Tabellenblatt !", vbCritical
Exit Sub
End If

'Check, ob gültiges Jahr
If IsNumeric(.Range("J5")) Then 'ausgewähltes Jahr
iJahr = Range("J5")
Else
MsgBox "ausgewähltes Jahr ist ungültig !", vbCritical 'Wert in Zelle nicht numerisch
Exit Sub
End If

'gültige Kalenderwoche - da die KW einer Liste entnommen wird, ist sie grundsätzlich gültig
'Wenn aber mehr als 1 Woche auszuwerten ist, gilt folgende Regel:
'maximal auswählbare KW = maximal mögliche KW - nkw +1, wobei nkw = Anzahl der auszuwertenden Wochen
'über sw_nKW wird gesteuert, was die maximal zulässige KW ist
Set ws_H = Worksheets("Hintergrunddaten")
mKW = WorksheetFunction.Max(ws_H.Range("C3:C54")) 'maximal erlaubte KW ohne Berücksichtigung von sw_nKW
mKW = IIf(sw_nKW = True, mKW - nKW + 1, mKW)
If iKW > mKW Then
MsgBox "Ungültige Kalenderwoche !" & vbCrLf _
& "Maximal zulässig für das Jahr " & iJahr & " ist " & mKW, vbCritical
Exit Sub
End If

'Bereich Kalenderwochen festlegen
erg = Application.Match(mKW + nKW - 1, ws_H.Range("C3:C54"), 0) + 2
If Not IsNumeric(erg) Then
MsgBox "Maximale KW in Hintergrunddaten nicht gefunden !", vbCritical
Exit Sub
End If
KW_Bereich = "C" & IIf(ws_H.Range("C3") = 1, 3, 2) & ":C" & erg 'Adresse KW-Bereich

'************************************************************************
' Leeren Tagesblätter für ausgewählte und darauffolgende Wochen
'************************************************************************
arr_WT = Array("Montag", "Dienstag", "Mittwoch", "Donnerstag", "Freitag", "Samstag")
On Error GoTo Error_handling
For w = LBound(arr_WT) To UBound(arr_WT)
For i = 1 To nKW
sSx = IIf(i = 1, "", "_" & i)
dName = arr_WT(w) & sSx
Set sh = Worksheets(dName)
Union(sh.Range("B11:H22"), sh.Range("K11:Q22"), sh.Range("B31:H42"), sh.Range("K31:Q42")).ClearContents
Union(sh.Range("B11:H22"), sh.Range("K11:Q22"), sh.Range("B31:H42"), sh.Range("K31:Q42")).Interior.ColorIndex = xlNone
With Union(sh.Range("B22:H22"), sh.Range("K22:Q22"), sh.Range("B42:H42"), sh.Range("K42:Q42")).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Next i
Next w
On Error GoTo 0

'************************************************************************
' In Quell-Tabelle 'Eintragungen' Farb-Markierungen bei Fehlern entfernen
'************************************************************************
Union(.Range("A2:B" & LoL_Q), .Range("E2:E" & LoL_Q)).Interior.ColorIndex = xlNone 'Datum, ISA und Uhrzeit

'************************************************************************
' Quelldaten zeilenweise auf die Tagesblätter verteilen
'************************************************************************
Application.ScreenUpdating = False 'Bildschirm-Update temporär unterdrücken
Application.Calculation = xlCalculationManual 'Automatisches Berechnen ausschalten

For qr = 2 To LoL_Q 'Schleife über alle Positionen in 'Eintragungen'
KW = WorksheetFunction.WeekNum(.Range("A" & qr), 21) 'Kalenderwoche der aktuellen Position

'Name Wochentag ermitteln und Sonntags-Positionen aussortieren
If KW >= iKW And KW <= iKW + nKW - 1 Then 'nur lfd. und darauffolgende nKW - 1 Wochen sind hier relevant
dName = Format(.Range("A" & qr), "dddd") 'Name Wochentag
If dName = "Sonntag" Then 'dieser Wochentag ist ungültig
fDatum = fDatum + 1 'falsche Wochentage zählen
.Range("A" & qr).Interior.ColorIndex = 6 'fehlerhaftes Datum gelb markieren
GoTo Weiter
End If

'Feiertage werden ebenfalls aussortiert
erg = Application.Match(.Range("A" & qr), ws_H.Range("A85:A109"), 0) 'Datum in Feiertagstabelle suchen
If IsNumeric(erg) Then
If ws_H.Range("D" & 84 + erg) = "x" Then
.Range("A" & qr).Interior.ColorIndex = 3 'wenn Feiertag - dann Datum rot markieren
fDatum = fDatum + 1
GoTo Weiter
End If
End If

'Datenblatt für die dem Datum entsprechende KW zuordnen
If KW > iKW Then dName = dName & "_" & KW - iKW + 1 'Name Wochentag_n
On Error GoTo Error_handling
Set sh = Worksheets(dName)
On Error GoTo 0

'welche Schichtzeiten sind zu nehmen ?
erg = Application.Match(KW, ws_H.Range(KW_Bereich), 0) + 1 'Suche KW in 'Hintergrunddaten'
If Not IsNumeric(erg) Then
MsgBox "Kalenderwoche " & KW & " in Blatt Hintergrunddaten nicht gefunden !", vbCritical
Exit Sub
Else
h = erg 'Zeilen# Schichtzeiten für KW
End If

'Ermitteln Koordinaten für die Zieltabelle
If CDate(.Range("E" & qr)) >= CDate(ws_H.Range("G" & h)) And CDate(.Range("E" & qr)) <= CDate(ws_H.Range("H" & h)) Then
sZeile = 11 'Frühschicht vor der Pause
zc = 2
ElseIf CDate(.Range("E" & qr)) >= CDate(ws_H.Range("I" & h)) And CDate(.Range("E" & qr)) <= CDate(ws_H.Range("J" & h)) Then
sZeile = 31 'Frühschicht nach der Pause
zc = 2
ElseIf CDate(.Range("E" & qr)) >= CDate(ws_H.Range("K" & h)) And CDate(.Range("E" & qr)) <= CDate(ws_H.Range("L" & h)) Then
sZeile = 11 'Spätschicht vor der Pause
zc = 11
ElseIf CDate(.Range("E" & qr)) >= CDate(ws_H.Range("M" & h)) And CDate(.Range("E" & qr)) <= CDate(ws_H.Range("N" & h)) Then
sZeile = 31 'Spätschicht nach der Pause
zc = 11
Else
fUhrzeit = fUhrzeit + 1 'fehlerhafte Uhrzeit (liegt außerhalb aller Schichtzeiten)
Range("E" & qr).Interior.ColorIndex = 6 'Uhrzeit gelb markieren
GoTo Weiter 'Position nicht verarbeiten
End If

'Ermitteln nächste freie Zeile im Schichtzeiten-Quadranten und speichere dort die Daten
sw = False
For zr = sZeile To sZeile + 11 'Schleife zur Suche der nächsten freien Zeile
If sh.Cells(zr, zc) = "" Then
.Range("B" & qr & ":H" & qr).Copy Destination:=sh.Cells(zr, zc) 'Datenzeile komplett übertragen
sw = True
Exit For
End If
Next zr

'Zeile aus 'Eintragungen' konnte aus Platzmangel nicht bei zugehöriger Schicht gespeichert werden
If sw = False Then
.Range("B" & qr).Interior.ColorIndex = 6 'ISA gelb markieren
MsgBox "Eintragung Zeile " & qr & Chr(10) _
& "konnte nicht eingefügt werden" & Chr(10) _
& "Tabelle " & dName, vbExclamation
End If
End If
Weiter:
Next qr
End With

' Fehlerbehandlung
Error_handling:
If Err.Number <> 0 Then
MsgBox "Prozedur abgebrochen !" & Chr(10) _
& "Fehler " & Err.Number & " " & Err.Description & Chr(10) _
& "Tabellenblatt " & dName & " fehlt !", vbCritical
Else
MsgBox "Übernahme der Daten ist abgeschlossen !" & Chr(10) _
& "Anzahl Uhrzeit-Fehler " & fUhrzeit & Chr(10) _
& "Anzahl Datum-Fehler: " & fDatum & Chr(10) _
& "Anzahl Einfüge-Fehler: " & fInsert, IIf(fDatum + fUhrzeit = 0, vbInformation, vbExclamation)
End If

'Abschluss-Arbeiten
On Error GoTo 0 'Standard für Fehlerbehandlung aktivieren
Application.ScreenUpdating = True 'Bildschirm-Update wieder aktivieren
Application.Calculation = xlCalculationAutomatic 'Automatisches Rechnen wieder einschalten
Application.Calculate 'Neuberechnung durchführen
End Sub

Knutschkugel
17.09.2014, 07:29
Wow ich danke dir für die Hilfe bzw umsetzung des Projektes.

Knutschkugel
25.09.2014, 15:18
Option Explicit
'=====================================================================
' Version 14.6 vom 23.08.2014
'=====================================================================

'=====================================================================
' Konstanten für beide Prozeduren
'=====================================================================
Const cParcel_u As Integer = 3 'Spalte 1. Frachtführer kien
Const cParcel_o As Integer = 12 'Spalte letzter Frachtführer klein
Const cCarrier_u As Integer = 13 'Spalte VF für 1. Frachtführer groß
Const cCarrier_o As Integer = 23 'spalte VF für letzten Frachtführer groß
Const cLookAt As String = "xlPart" 'xlPart = Teilausdruck, xlWhole = volle Übereinstimmung (z Zt nicht genutzt)

'=====================================================================
' Variable, die in beiden Prozeduren verwendet werden
'=====================================================================
Dim q As Long 'Zeilen# Dummy-Import = Quell-Tabelle
Dim z As Long 'Zeilen# Dummy_Werte = Ziel-Tabelle
Dim c As Long 'Spalten#Ziel-Tabelle
Dim LoL As Long 'letzte Zeile Ziel-Tabelle
Dim ws_Q As Worksheet 'Quell-Tabelle
Dim erg As Variant 'Ergebnis Match
Dim Zelle As Range 'Ergebnis Find


Private Sub CommandButton1_Click()
'=====================================================================
' Aktualisieren Frachtfüher (Klein) mit 'Dummy-Import')
' Die Positionen in 'Dummy_Import' werden zeilenweise verarbeitet.
' Datum und Frachtführer sind die Koordinaten für Dummy_Werte;
' in diese Zelle wird der Wert aus Dummy-Import kopiert.
' Alle übrigen Zellen in Dummy_Werte bleiben unverändert.
'=====================================================================
'Initialisieren
LoL = Cells(Rows.Count, "B").End(xlUp).Row 'Letzte Zeile in Dummy_Werte

'Koordinaten Ziel-Tabelle suchen und danach Wert aus Dummy_Import speichern
Set ws_Q = Worksheets("Dummy_Import")
With ws_Q
For q = 1 To .Cells(Rows.Count, "A").End(xlUp).Row 'von der 1. bis zur letzten Zeile in Dummy_Import
erg = Application.Match(.Range("A" & q), Range("B6:B" & LoL), 0) 'Suche Datum aus 'Dummy_Import' in 'Dummy_Werte'
If IsNumeric(erg) Then
z = erg + 5 'Zeilen# in Dummy_werte
Set Zelle = Range(Cells(4, cParcel_u), Cells(4, cParcel_o)).Find(.Range("B" & q), LookIn:=xlValues, LookAt:=xlWhole) 'Suche Frachtführer
If Not Zelle Is Nothing Then 'Frachtführer gefunden
c = Zelle.Column 'Spalten# in Dummy-Werte
Cells(z, c) = .Range("C" & q) 'Wert aus Dummy_Import nach Dummy_Werte kopieren
End If
End If
Next q
End With
End Sub


Private Sub CommandButton2_Click()
'=====================================================================
' Aktualisieren Frachtführer (Groß) mit Daten aus 'Eintragungen'
' Die Positionen in 'Eintragungen' werden zeilenweise verarbeitet,
' soweit Termin numerisch ist.
' Datum und Frachtführer sind die Koordinaten für Dummy_Werte.
' Für jede Ziel-Zelle kann es mehrere Positionen geben; deren Werde
' VF und LP werden kumuliert.
' Bei der ersten Position für eine Ziel-Zelle werden die Daten in die
' Ziel-Zelle kopiert, die nächsten Positionen addieren dann die Werte.
' Die Steuerung erfolgt über Array, in dem pro Koordination-Kombinlation
' ein Feld vorgesehen ist.
' Kumulierte Werden werden farblich markiert.
' Alle übrigen Zellen in Dummy_Werte bleiben unverändert.
'=====================================================================
Dim arr() 'Array zur Steuerung bei Kumulation der Werte
Dim y As Long 'Index 2 arr

'Initialisieren
LoL = Cells(Rows.Count, "B").End(xlUp).Row 'Letzte Zeile Datum in Dummy_Werte
Range(Cells(6, cCarrier_u), Cells(LoL, cCarrier_o + 1)).Interior.ColorIndex = xlNone 'Farbe bei kumulierten Werten entfernen
y = (cCarrier_o - cCarrier_u) / 2 + 1 'Anzahl Frachtführer Groß
ReDim arr(1 To LoL, 1 To y) 'Array mit je einem Feld für die Kombination Datum / Frachtführer
Application.ScreenUpdating = False

'Koordinaten Ziel-Tabelle suchen, Wert speichern bzw kumulieren
Set ws_Q = Worksheets("Eintragungen") 'Quell-Tabelle
With ws_Q
For q = 2 To .Cells(Rows.Count, "A").End(xlUp).Row 'Datum-Werte von der 2. bis zur letzten Zeile in Eintragungen
If IsNumeric(.Range("B" & q)) Then 'nur wenn Termin numerisch ist
erg = Application.Match(.Range("A" & q), Range("B6:B" & LoL), 0) 'Suche Datum in Dummy_Werte
If IsNumeric(erg) Then 'Treffer
z = erg + 5 'Zeilen# Frachtführer in Dummy_Werte
erg = Application.Match(.Range("D" & q), Range(Cells(4, cCarrier_u), Cells(4, cCarrier_o)), 0) 'Suche nun Frachtführer
If IsNumeric(erg) Then 'Frachtführer gefunden
c = erg + cParcel_o 'Spalten# Frachtführer in Dummy_Werte
y = (c - cCarrier_u) / 2 + 1 'Nummer aktueller Carrier
If arr(z, y) = "" Then 'für diese Koordinaten Datum /Frachtführer lagen bisher keine neuen Werte vor
'Zeile wurde noch nicht bearbeitet, die Werte überschreiben die vorhandenen
Cells(z, c) = .Range("F" & q) 'VF
Cells(z, c + 1) = .Range("G" & q) 'LP
arr(z, y) = 1 'Flag für Kumulierung setzen
Else
'zweite und jede weitere Position, die neuen Werte sind zu addieren, das Ergebnis ist farblich zu markieren
Cells(z, c) = Cells(z, c) + .Range("F" & q) 'VF kumukieren
Cells(z, c + 1) = Cells(z, c + 1) + .Range("G" & q) 'LP kumulieren
Range(Cells(z, c), Cells(z, c + 1)).Interior.ColorIndex = 6 'Werte VF / LP farblich markieren als kumuliert
End If
End If
End If
End If
Next q
End With

'Abschlussarbeiten
Application.ScreenUpdating = True
End Sub


Hallo Aloys,
Die Datei Arbeitet perfekt,
ist es möglich das o.g. Scriptbei Frachtführer Klein die Werte auch Kumuliert wie bei Frachtführer Groß?
Kann nur 1000 mal Danke Sagen :-)

MfG

aloys78
25.09.2014, 16:12
Hallo Martin,
ist es möglich das o.g. Scriptbei Frachtführer Klein die Werte auch Kumuliert wie bei Frachtführer Groß?
Was heisst das konkret ?
Sollen da auch als Quelldaten "Eintragungen" genommen werden und nach dem gleichen Verfahren gearbeitet werden ?

Außerdem kannst du mir dann mal eine aktuelle Datei zur Verfügung stellen, da ich hier nur über Fragmente verfüge.

VG
Aloys

Knutschkugel
16.10.2014, 09:17
Hallo aloys78,
Habe das Problem für mich mit Excel Formeln lösen können mit dem Frachtführer.
Entschuldige bitte das ich mich eine ganze Weile nicht gemeldet hatte deswegen war auf Arbeit einfach viel los und im Privaten auch so das ich die Arbeiten an der Datei zwischenzeitlich gar einstellen musste.

MfG

p.s.
Eine Sache Pflege ich grade noch die Daten in der Datei ein da bräuchte ich dann nochmal sicherlich deine hilfe

aloys78
16.10.2014, 09:33
Hallo Martin,
Eine Sache Pflege ich grade noch die Daten in der Datei ein da bräuchte ich dann nochmal sicherlich deine hilfe
Nur zu - dann melde dich zu gegebener Zeit !

VG
Aloys

Knutschkugel
17.10.2014, 11:59
Hallo aloys78,

Habe mal eine Frage zum Aufbau der geplanten Änderungen.

Unter Eintragungen würden noch zusätzlich zwei Spalten hinzugefügt werden.
Haben ja die Spalte VF / LP / P
es soll in Zukunft so aussehen VF / LP / M / P 1 / P
Anhand der Terminnummer sollen folgende Daten aus der Webseite Importiert werden.
Die Daten für P1 soll er sich von einer internen Webseite holen die in Spalten unterteilt ist. Wobei hier die betreffende Spalte folgende Zahlen enthält „5% 280“ hier sollen jedoch nur die 280 eingetragen werden.
Sollte das problemlos möglich sein war es schön wen es für LP auch so funktionieren würde da ist es genauso aufgebaut werden.

Ansonsten müsste es über die Excel Webseiten importier Funktion geregelt werden denke ich sollte das über die Webseite nicht funktionieren.

aloys78
18.10.2014, 06:13
Hallo Martin,
Unter Eintragungen würden noch zusätzlich zwei Spalten hinzugefügt werden.
Haben ja die Spalte VF / LP / P
es soll in Zukunft so aussehen VF / LP / M / P 1 / P

Habe mal eine Frage zum Aufbau der geplanten Änderungen.

Die Erweiterung des Codes zum Kopieren der 2 zusätzlichen Spalten ist mE kein Problem.

Voraussetzung
- die Tabellenblätter Montag, ... sind entsprechend angepasst,
- der Import der Daten von der WebSite wird von dir realisiert,
- du stellst die erweiterte Datei zur Verfügung.

VG
Aloys

Knutschkugel
18.10.2014, 07:16
Wie gesagt wegen Import der Webseite ist für mich jetzt die Frage, würde das über die importieren Funktion von Webseiten von Excel erfolgen oder ist das auch per vba möglich?

aloys78
18.10.2014, 09:17
Hallo Martin,
Wie gesagt wegen Import der Webseite ist für mich jetzt die Frage, würde das über die importieren Funktion von Webseiten von Excel erfolgen oder ist das auch per vba möglich?
Sorry, bezüglich Import von Daten von einer (internen) WebSite habe ich keine Erfahrung.

Ich empfehle dir, für dieses spezielle Problem hier im Forum ein neues Thema zu eröffnen.

VG
Aloys

Knutschkugel
08.12.2014, 08:51
Hallo aloys78,

bin mit der Anpassung soweit Durch :-)
Schicke dir das Dokument wieder per PN aufgrund der Datei Größe.

Was hat sich geändert:
Im Blatt "Eintragungen" gibt es jetzt 9 Spalten anstatt drei 3 die in die entsprechenden Wochentage Kopiert werden müssten.
Im Blatt „Dummy_Werte“ ist jetzt Spalte M hinzugekommen

Es gibt jetzt noch ein Blatt „Prep“
Im Spalte M stehen die Terminnummern und in Spalte K stehen die Units/Einheiten die in Blatt „Eintragungen“ in Spalte L eingetragen werden müssten beim Drücken von „Update Tagesblätter“

Nach Drücken von „Update Tagesblätter“ erscheint ja die Meldung ob Fehler aufgetreten sind. Ist es möglich zu diesen Fehlern die Terminnummer in Spalte Q Zeile 27-40 Einzutragen und entsprechend „Kreuze“ zu setzen.
Die Farbliche Kennzeichnung Hilft zwar die Sachen zu finden jedoch bei einer längeren terminliste ist das Auflisten zur schnelleren Findung der Termin einfacher Denke ich


Frage allgemein:
Ist es eigentlich möglich Office auf das Englishe Trennzeichen System umzustellen ist das per VBA Script möglich das das entsprechend umgestellt wird?


MfG

aloys78
10.12.2014, 21:16
Hallo Martin,
Im Blatt "Eintragungen" gibt es jetzt 9 Spalten anstatt drei 3 die in die entsprechenden Wochentage Kopiert werden müssten.
Bei den Wochentagen sehe ich nur 7 Spalten, „Aktionen“ und „Dummy“ sind dort nicht vorhanden.
Im Blatt „Dummy_Werte“ ist jetzt Spalte M hinzugekommen
Das ist die Spalte „Dummy“ ! Und warum sollte ich das wissen ?
Es gibt jetzt noch ein Blatt „Prep“
Im Spalte M stehen die Terminnummern und in Spalte K stehen die Units/Einheiten die in Blatt „Eintragungen“ in Spalte L eingetragen werden müssten beim Drücken von „Update Tagesblätter“
Das heißt, die Units in Sp K sind vor der Verteilung der Daten auf die Wochentage in die Spalte L kopieren.
Was bedeutet die Terminnummer in Sp M ?
Und wie findet man für eine Zeile in „Eintragungen“ die zugehörigen Units ?
Nach Drücken von „Update Tagesblätter“ erscheint ja die Meldung ob Fehler aufgetreten sind. Ist es möglich zu diesen Fehlern die Terminnummer in Spalte Q Zeile 27-40 Einzutragen und entsprechend „Kreuze“ zu setzen.
Die Farbliche Kennzeichnung Hilft zwar die Sachen zu finden jedoch bei einer längeren terminliste ist das Auflisten zur schnelleren Findung der Termin einfacher Denke ich
Die Fehlermeldung wird ausgegeben, wenn ein Tagesblatt im 14-Tage Zeitraum fehlt.
Willst du damit sagen, dass beliebig viele Tagesblätter fehlen können ?
Was ist denn „Terminnummer“ und wie passt die zu einem fehlenden Tagesblatt ?
Wo soll denn das Kreuz hin ?

Beispieleintragungen zur besseren Veranschaulichung der Aufgabenstellung sind dabei immer hilfreich.

Gruß
Aloys

Knutschkugel
11.12.2014, 02:12
Hallo Aloys78,

Mit den Wochentagen ist richtig das ist irgendwie untergegangen, wird aber heute vormittag noch geändert und dir neu zukommen lassen.

Die Änderungen hatte ich aufgelistet das du schneller ziehst wo sich was geändert hat ��

Nein es fehlen keine Tagesblätter, meine die Fehlermeldung wegen der Uhrzeit zb, oder falls ein Datum auf ein Feiertag fällt bzw ein Doppelpunkt anstatt eines Punktes geschrieben wird, da sagt er ja momentan Fehler im Uhrzeit bzw Datum was soweit ja richtig ist.
Werde dir in der neuen Datei bsp Daten dafür eintragen.

Danke schonmal im vorraus für deine Mühe und Geduld

Knutschkugel
11.12.2014, 06:20
mh kann irgendwie mein Beitrag von vorhin nicht Bearbeiten.

Beim Updaten der Carrier müsste jetzt natürlich die Formel auch angepasst werden was wieweit zusammengezählt wird, hoffe bringe das jetzt verständlich rüber^^

Wir haben ja im Tab "Dummy_Werte" in Spalte N-Y die Carrier drin stehen wo jeder auf zwei Spalten aufgeteilt ist. dabei würde ich jetzt auch belassen. Schön wäre es wenn er die Werte wie folgt Aktuallisiert bzw zusammen Zählt:

Bsp.:
Tab "Dummy_Werte"
Carrier 1 in Sp N/O
SP N werden die werte aus SP F;I;K;L;H zusammengezählt (aus dem Tab Eintragungen)
SP O werden die werte aus SP G:J zusammengezählt (aus dem Tab Eintragungen)

aloys78
12.12.2014, 06:42
Hallo Martin,
mh kann irgendwie mein Beitrag von vorhin nicht Bearbeiten.
Das geht nur eine begrenzte Zeit.

Die neue Datei habe ich erhalten; du kannst solche Links für Download von Dropbox auch hier im Forum nutzen, dazu brauchst du keine PN zu schreiben.

Auf meine Fragen bist du leider nur unzureichend eingegangen.

Zum Punkt 1 - neue Spaltenanzahl
geklärt durch die neue Datei

Punkt 4 - Fehlerkennzeichnung
geklärt durch Beispiel in der neuen Datei

Punkt 2 - die Erläuterung zur neuen Spalte
geklärt

Punkt 2 - dein neuer Wunsch
Schön wäre es wenn er die Werte wie folgt Aktuallisiert bzw zusammen Zählt:
verstehe ich das richtig: das gilt nur für das Spaltenpaar N/O, die übrigen Spalten bleiben unverändert ?

Punkt 3 - das neue Tabellenblatt 'Prep'
hier bist du auf meine Fragen überhaupt nicht eingegangen.

Gruß
Aloys

Knutschkugel
12.12.2014, 11:19
Hallo, die frage hatte ich irgendwie nicht für voll genommen...
Ja die Units müssten vorher rüber kopiert werden bevor die Eintragungen in die Wochenblätter erfolgt.
Die Termin Nummer ist mir der ISA aus Spalte B unter Eintragungen gleichzusetzen.
Nein betrifft nicht nur die Spalten N und O die würde auf alle täglichen carrier treffen sprich die folgenden Spalten auch noch.

Danke nochmal für deine Mühe und Geduld

aloys78
14.12.2014, 05:34
Hallo Martin,
… die frage hatte ich irgendwie nicht für voll genommen...
Das könnte ich jetzt noch dadurch toppen, dass ich deine Problemstellung nicht ernst nehme.

Aber mal im Ernst: sage mir doch mal, welche Frage genau du nicht voll genommen hast. Vielleicht muss ich noch an mir arbeiten !

Und zur Sache selbst: wieviel Zeilen wird das Blatt ‚Eintragungen‘ haben und wieviel Units-Werte wird es im neuen Blatt ‚Prep‘ geben, die nach ‚Eintragungen‘ zu übernehmen sind ? Es geht mir um eine Größenordnung, nach der ich dann die Suchtechnik ausrichten möchte.

Gruß
Aloys

Knutschkugel
15.12.2014, 12:14
Hallo Aloys78,

Unter Eintragungen würde ich maximal von 10.000 Zeilen ausgehen wobei ich abgeschlossene Wochen rauskopieren werde und in einer externen Backup Datei so dass unter Eintragungen immer nur Daten stehen für zukünftige Anlieferungen um die Datei einfach nicht künstlich groß zu halten, die Dummy Werte werden n natürlich schon für das ganze Jahr vorgetragen.
Zu den Unit Werten im Blatt Prep gehe ich von aus das die Zahl 600 ist, wobei du da ja siehst das Sie leider nicht sauber Zeile für Zeile ohne zwischen Zeile stehen, sprich es werden unter Umständen extrem viele Zeilen kontrolliert werden müssen (würde es da was bringen die betreffenden Spalten Benutzerdefiniert Sortieren zu lassen? Wobei das Sortieren ja auch schon Zeitaufwendig ist).

Hatte leider einfach die frage dazu von dir überlesen gehabt, wieso das weiß ich nicht, werde mir aber in Zukunft deine Texte mindestens zwei mal durch lesen um auch wirklich alles zu beantworten.
Schönen Start in die neue Woche
Gruß
Martin

aloys78
15.12.2014, 14:39
Hallo Martin,
Zu den Unit Werten im Blatt Prep ...
Die Angaben zum Mengengerüst sind hilfreich.
Das Tabellenblatt selbst, sagen wir es mal so, kam mir etwas unaufgeräumt vor.
Ich löse das Problem so, dass ich die Sp K durchsuche nach Zellen, die eine Ganzzahl > 0 enthalten. Alle diese Einträge werden in einem Array gespeichert, so dass der Zugriff vom Tabellenblatt 'Eintragungen' sehr schnell sein dürfte.

Beim Blatt 'System_Werte' bin ich noch auf eine Frage gestoßen. Bisher ist es so, wenn mehrere Zeilen in 'Eintragungen' zutreffen, dass dann das Ergebnis im Block Carrier farblich zu markieren ist. Trifft diese Anforderungen auch noch bei den neuen Berechnungsformeln zu ?

Gruß
Aloys

Knutschkugel
15.12.2014, 23:01
Hallo,

da gebe ich dir recht das es unaufgeräumt ist aber so wird es immer aussehen da es so Importiert wird von der Webseite, ist das original Import Format.
Bei der Durchsuchung nach Spalte K wird da die Spalte mit den Terminnummern/ISA immernoch berücksichtigt für die eintragungen?

Ja würde die fabliche Sortierung bei mehreren Carriern an selben Tag gerne farblich hervorheben.

Gruß

Knutschkugel
17.12.2014, 20:08
Hallo Aloys,
Habe grade festgestellt das im Tab Dummy_Werte in Spalte U Falsche werte Importiert werden, Normalerweise dürften da nur Werte von TAB Eintragungen erfolgen da steht aber die Spedition nur Dienstags und Donnerstags drin, aber irgendwie werden auch zahlen für Montag Mittwoch Freitag eingetragen obwohl die Zahl da 0 wäre... Siehst du auch in der BSP Datei die du vorliegen hast

aloys78
17.12.2014, 21:19
Hallo Martin,
Habe grade festgestellt das im Tab Dummy_Werte in Spalte U Falsche werte Importiert werden
Meinst du wirklich das Blatt Dummy_Werte und da nur die Spalte U ?
Wenn ja, spielt das noch eine Rolle ?
Denn diie Werte sind doch zukünftig für VF und LP getrennt nach neuen Formeln zu ermitteln.

Und dazu habe ich noch eine Frage. In deiner Beispieldatei sind die Terminbereiche von 'Eintragungen' und 'System_Werte' unterschiedlich. Wie sollen nun die Werte für den Carrier-Bereich gebildet werden ?
a) der Carrier-Bereich wird zunächst vollständig gelöscht und danach werden die Zellen gefüllt, für die Werte vorliegen, oder
b) der Carrier-Bereich bleibt nach Betätigen des Buttons erhalten, und nur die Zellen werden auf den neuesten Stand gebracht, für die über Datum und Frachtführer auch Daten vorhanden sind.

Gruß
Aloys

Knutschkugel
17.12.2014, 21:41
Ja ich meine wirklich nur im Blatt Dummy_Werte bei Spalte "U" Wieso das da so ist weiß ich nicht ist mir da nur aufgefallen weil der Frachtführer wie gesagt nur 2 mal die woche kommt aber an allen fünf Tagen stehen da Werte drin...
Du hast aber recht da wir ja eine neue Formal haben fällt das ja in der neuen Version eh raus :-D

Habe jetzt mal 10 Werte verglichen und alle sind se Identisch die Ich gefunden habe , hättest du Eine Zeile in System_Werte für mich wo die Zahlen abweichen?

Würde Variante B bevorzugen, einzige was mir dazu einfällt findet er an einen Tag unter Eintragungen den Frachtführer nicht weil er entfernt wurde da er doch nicht Anliefert, das diese Werte wo er nix findet auf 0 Setzt

owe ist das Kompliziert geschrieben (Versuche das morgen nochmal in ordentliches Deutsch zu fassen :-) )

aloys78
18.12.2014, 06:22
Hallo Martin,

anbei eine neue Version. Link entfernt.
Die durchgeführten Änderungen sind jeweils zu Beginn des Codes dokumentiert.

Rahmenbedingungen für das Testen
- Ein fehlerhafter Verweis führte dazu, dass die Format-Funktion nicht mehr funktionierte (Verweis korrigiert),
- Das neue Datenblatt enthält keine korrespondierenden ISA-Daten,
- Im Blatt Eintragungen waren 2 fehlerhafte Datumswerte und eine ungültige Uhrzeit,
- Außerdem enthalten in Sp D einige Frachtführer wie zB DACHS und DHLF noch einen Punkt am Schluß,
- Der neue Fehlerblock Q27:Tx war im unteren Teil mit Schriftfarbe weiß definiert,
- Für ‚Systemwerte‘ wurde Variante b realisiert.

Die Änderungen waren umfangreicher als anfangs vermutet. Ich schließe daher nicht aus, dass du bei deinen intensiven Tests noch Fehler findest.

Gruß
Aloys

Knutschkugel
18.12.2014, 11:23
Hallo Aloys78,

Werde ich nachher gleich testen ich bedanke mich schon mal.

Das einige Frachtführer mit einen Punkt versehen sind ist richtig, da diese Werte nicht mit bei Dummy Werte reingerechnet werden sollten. (waren sonderlieferungen und daher nicht regelmäßig)

Die fehlerhafte Uhrzeit und Datumswerte waren für dich wegen dem Bsp. Mit ISA/Terminnummer auflisten und das entsprechende Kreuz setzen.

Die anderen Punkte weiß ich Grade aus dem Kopf nicht und muss ich mir dann anschauen wenn ich nachher am PC bin


Danke nochmal

aloys78
18.12.2014, 12:08
Hallo Martin,
Das einige Frachtführer mit einen Punkt versehen sind ist richtig, da diese Werte nicht mit bei Dummy Werte reingerechnet werden sollten.
Wenn ich das vorher gewußt hätte, dann hätte ich zum Testen für den Oktober nicht extra den Punkt entfernen müssen.

Ich kann dir aber bestätigen, dass sie nicht mit einbezogen werden, wenn der Punkt anhängt.

Gruß
Aloys

PETMOR
28.12.2014, 08:51
Hallo,
schade das man die letzte Version nicht laden kann,
aus diesem Projekt kann man viel lernen,
oder gibts davon auch eine version mit dummy-daten,
würde mich sehr freuen,
mfg Petmor

Knutschkugel
28.12.2014, 10:08
Hallo,
Hatte mir die Version vor den Feiertagen angeschaut,
@ Aloys78
Soweit funktionieren deine Formeln sehr gut, habe aber gesehen das ich noch zwei drei Formel Fehler drin habe für die Berechnung der angezeigten Daten. Werde diese im Anhang Anfangdes neuen Jahres gleich beheben. Und dann sieht man denke ich erst genau ob es so funktioniert wie gedacht.
@Petmore
Sobald ich die Formel Anpassung gemacht habe kann ich eine Dummy Datei sehr gerne hier hoch laden und sollten im Test keine Fehler auftauchen, wird aber erst gegen Ende KW 2 sein da es erst in KW mit Arbeit wieder weiter geht

Wünsche allen schonmal ein frohes neues Jahr im voraus

Knutschkugel
07.01.2015, 09:37
Hallo Aloys78,
es Funktioniert bis jetzt sehr gut, habe noch einige kleine Fehler in meinen Formeln gefunden die ich jetzt natürlich noch anpassen muß. Aber so auf dem ersten Blick funktioniert es wie es soll und auch von der Geschwindigkeit bin ich sehr begeister

Danke auf jeden fall

Knutschkugel
07.01.2015, 12:05
Kleiner Fehler entdeckt.
Möchte ich unter Dummy Werte die Carrier Aktrualisieren Supuckt er mir eine Fehler Meldung aus
Laufzeitfehler 13:
Typen unverträglich
Ein Klick auf Debuggen springt er auf folgende Zeile
sum_VF = .Range("F" & q) + .Range("H" & q) + .Range("I" & q) + .Range("K" & q) + .Range("L" & q) 'V19

Knutschkugel
12.01.2015, 20:33
Hallo Aloys78,
Kannst du mir was sagen zu dem Laufzeitfehler?'

gruß Martin

aloys78
12.01.2015, 21:16
Hallo Martin,
Typen unverträglich
Der Fehler zeigt an, dass hier Datentypen unverträglich sind.
sum_VF ist als Zahl (long) definiert. Vielleicht befindet sich in den beteiligten Zellen Text-Werte.
Schau dir die betreffende Zeile an, q ist die Zeilennummer der Tabelle 'Eintragungen', und überprüfe, ob in einer der Zellen nicht numerische Inhalte vorkommen.

Gruß
Aloys

Knutschkugel
12.01.2015, 21:52
ah ok danke werde ich mal schauen :-)
schönen Abend noch

Knutschkugel
19.01.2015, 15:12
Hallo Aloys,

Ich komme da mit der Fehlermeldung leider nicht weiter. Würde dir die Momentane Datei per PN mal zuschicken.

aloys78
19.01.2015, 22:48
Hallo Martin,
Ich komme da mit der Fehlermeldung leider nicht weiter.
Du hattest die Zeile, in der der Fehler auftritt, schon lokalisiert. Die Variable q enthält die Zeilennummer der Quell-Tabelle 'Eintragungen', nämlich 1431.

Schau dir mal die Zeile 1431 an:
=Dummy_Werte!$P$98
Und die Tabelle Dummy_Werte enthält ab Zeile 98 nur noch #Div/0
Der Versuch, diesen Wert bei einer Addition zu nutzen, führt zum Fehler.

Gruß
Aloys

Knutschkugel
20.01.2015, 14:13
Hallo Aloys,


Ist es möglich die Abfrage auf die letzten 30 Tage zu beschränken ? Würde dafür in A1 das jeweils aktuelle Datum von dem Tag eintragen und davon soll er nur die werte für die letzten/Plus 30 Tage übertragen werden und so nicht so weit in die Zukunft gehen so das er diese Fehler nicht mehr nimmt wo noch kein Mittelwert gebildet werden kann.

Gruß

aloys78
20.01.2015, 20:25
Hallo Martin,
Ist es möglich die Abfrage auf die letzten 30 Tage zu beschränken ?
Kannst du das mal konkretiseren ?
Derzeit werden ja alle Zeilen in 'Eintragungen' verarbeitet. Wie soll das konkret in Zukunft aussehen ?

Gruß
Aloys

Knutschkugel
20.01.2015, 21:14
In A1 Würde ich dir Formel setzen für das Aktuelle Datum von da aus soll er max 30 Tage in die Zukunft gehen soweit reichen die Dummy werte auf jeden fall und in die Vergangenheit können wir es im Grunde so lassen bzw können es falls es einfacher ist auch auf 30 Tage Beschränken da es ja alle 1-2 Tage gemacht wird ist ja die Vergangenheit eigentlich immer Eingetragen.

aloys78
21.01.2015, 14:39
Hallo Martin,

ich habe das jetzt so gelöst, dass ich die Datumswerte in 'Eintragungen' mit dem Datum heute() plus 30 Tage vergleiche.
Eine Eintragung in A1 ist nicht erforderlich.

Gruß
Aloys




Private Sub CommandButton2_Click()
'=====================================================================
' Aktualisieren Frachtführer (Groß) mit Daten aus 'Eintragungen'
' Die Positionen in 'Eintragungen' werden zeilenweise verarbeitet,
' soweit Termin ein Datum ist.
' Datum und Frachtführer sind die Koordinaten für Dummy_Werte.
' Für jede Ziel-Zelle kann es mehrere Positionen geben; deren Werte
' VF und LP werden kumuliert.
' Bei der ersten Position für eine Ziel-Zelle werden die Daten in die
' Ziel-Zelle kopiert, die nächsten Positionen addieren dann die Werte.
' Die Steuerung erfolgt über Array, in dem pro Koordination-Kombinlation
' ein Feld vorgesehen ist.
' Kumulierte Werte werden farblich markiert.
' Alle übrigen Zellen in Dummy_Werte bleiben unverändert.

':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
' Änderungen in Version 19
' - Spalte M wurde zusätzlich eingefügt, daher verschieben sich V19
' bei Carrier die Spalten. V19
' - Carrier 1 Sp N (VF) V19
' hier wird die Summe der Spalten F, H, I, K und L aus der V19
' korrespondierenden Zeile in 'Eintragungen' eigefügt V19
' - Carrier 1 Sp O (LP) V19
' hier wird die Summe der Spalten G:J aus der korrespondierenden V19
' Zeile in 'Eintragungen' eingefügt V19
' Korrespondierend = Zeile in 'Eintragungen' mit gleichem Frachtführer V19
' und Datum. V19

' Änderungen in Version V20
' Die Daten aus 'Eintragungen' werden nur bis maximal aktuellem V20
' Datum plus 30 Tage verarbeitet v20

'=========================================================================
Dim arr() As Integer 'Array zur Steuerung bei Kumulation der Werte V19
Dim y As Long 'Index 2 arr
Dim sum_VF As Long 'Summe VF V19
Dim sum_LP As Long 'Summe LP V19
Dim sZeit As Single 'Startzeit V19
Dim LoL_Q As Long 'letzte Zeile in Quell-Tabelle V19

'Initialisieren
sZeit = Timer 'V19
LoL = Cells(Rows.Count, "B").End(xlUp).Row 'Letzte Zeile Datum in Dummy_Werte
Range(Cells(6, cCarrier_u), Cells(LoL, cCarrier_o + 1)).Interior.ColorIndex = xlNone 'Farbe bei kumulierten Werten entfernen
y = (cCarrier_o - cCarrier_u) / 2 + 1 'Anzahl Frachtführer Groß
ReDim arr(1 To LoL, 1 To y) 'Array mit je einem Feld für die Kombination Datum / Frachtführer
Application.ScreenUpdating = False

Set ws_Q = Worksheets("Eintragungen") 'Quell-Tabelle V19
With ws_Q ' V19
LoL_Q = .Cells(Rows.Count, "A").End(xlUp).Row ' V19

'Koordinaten Ziel-Tabelle suchen, Wert speichern bzw kumulieren
For q = 2 To LoL_Q 'Datum-Werte von der 2. bis zur letzten Zeile in Eintragungen V19
If IsDate(.Range("A" & q)) Then 'nur wenn die Zelle in Termin ein Datum ist V19
If .Range("A" & q) <= Now + 30 Then 'V20
erg = Application.Match(.Range("A" & q), Range("B6:B" & LoL), 0) 'Suche Datum in Dummy_Werte
If IsNumeric(erg) Then 'Treffer
z = erg + 5 'Zeilen# Frachtführer in Dummy_Werte
erg = Application.Match(.Range("D" & q), Range(Cells(4, cCarrier_u), Cells(4, cCarrier_o)), 0) 'Suche nun Frachtführer

If IsNumeric(erg) Then 'Frachtführer gefunden
c = erg + cParcel_o 'Spalten# Frachtführer in Dummy_Werte
y = (c - cCarrier_u) / 2 + 1 'Nummer aktueller Carrier
sum_VF = .Range("F" & q) + .Range("H" & q) + .Range("I" & q) + .Range("K" & q) + .Range("L" & q) 'V19
sum_LP = .Range("G" & q) + .Range("H" & q) + .Range("I" & q) + .Range("J" & q) 'V19
If arr(z, y) = 0 Then 'für diese Koordinaten Datum /Frachtführer lagen bisher keine neuen Werte vor V19

'Frachtführer in der Zeile wurde noch nicht bearbeitet, die Werte überschreiben die vorhandenen V19
Cells(z, c) = sum_VF 'VF
Cells(z, c + 1) = sum_LP 'LP
arr(z, y) = 1 'Flag für Kumulierung setzen
Else

'zweite und jede weitere Position, die neuen Werte sind zu addieren, das Ergebnis ist farblich zu markieren
Cells(z, c) = Cells(z, c) + sum_VF 'VF kumulieren V91
Cells(z, c + 1) = Cells(z, c + 1) + sum_LP 'LP kumulieren V91
Range(Cells(z, c), Cells(z, c + 1)).Interior.ColorIndex = 6 'Werte VF / LP farblich markieren als kumuliert
End If
End If
End If
End If 'V20
End If
Next q
End With

'Abschlussarbeiten
Application.ScreenUpdating = True
'MsgBox Timer - sZeit 'V19
MsgBox "Übernahme der Daten ist abgeschlossen !", vbInformation 'V19
End Sub

Knutschkugel
22.01.2015, 15:18
Hallo Aloys,

ist dies möglich das er auch Rückwirkend mit Aktualsiert +- 30 Tage?
Mit V20 bekomme ich jetzt die Fehlermeldung: "Laufzeitfehler 1004"
Range(Cells(6, cCarrier_u), Cells(LoL, cCarrier_o + 1)).Interior.ColorIndex = xlNone 'Farbe bei kumulierten Werten entfernen

Danke für deine Mühe

Knutschkugel
22.01.2015, 17:58
Danke Funktioniert Perfekt.
Er rechnet jetzt aber nur 30 Tage im Vorraus ein oder?

aloys78
22.01.2015, 21:12
Hallo Martin,
Danke Funktioniert Perfekt.
Er rechnet jetzt aber nur 30 Tage im Vorraus ein oder?
Ja - so war es doch von dir gewünscht, oder habe ich dich da falsch verstanden ?
ist dies möglich das er auch Rückwirkend mit Aktualsiert +- 30 Tage?
Was heisst das konkret ?
Bisher wird mit der 1. Zeile der Tabelle 'Eintragungen' begonnen; wie soll es künftig sein ?
Mit V20 bekomme ich jetzt die Fehlermeldung: "Laufzeitfehler 1004"
Im Moment kann ich da keinen Zusammenhang mit der Version 20 herstellen.

Gruß
Aloys

Knutschkugel
22.01.2015, 21:58
Hallo,
Ok er Trägt von der ersten zeile an ein bis maximal 30 Tage in die Zukunft? Das Reicht dann werde Morgen ausgibg zum Testen kommen und freue mich darauf schon :-) (Punkt 1 & 2 sollte beantwortet sein denke ich)

Mit dem Laufzeitfehler war meine Schuld hatte dein Code gegen dem Kompletten von dem Blatt getauscht und dadurch fehlte ein Teil.

Sage mal Gute Nacht und danke für deine Hilfe