Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1560to1564
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Werte zwischen Uhrzeiten einer Schicht zuweisen

Werte zwischen Uhrzeiten einer Schicht zuweisen
09.06.2017 11:46:25
Carsten
Hallo zusammen,
gestern hattet ihr mir schon gut geholfen und vlt Heute ja wieder :).
Und zwar geht es darum, dass ich eine Auswertung erstellt habe - mithilfe von "yummi". Und diese Auswertung versuche ich gerade zu optimieren, dazu benötige ich ein wenig hilfe, habe zwar schon Ideen wie ich es hin bekomme aber scheitert noch, leider :(
So sieht meine Auswertung aus: Hier Auftragsbezogen also alle Werte zwischen Start- und Endzeit

Schicht	        Zeit Anfang	Zeit Ende	Auftrag	Fehler Start	Fehler Ende
Frühschicht	29.5.17 06:00	29.5.17 08:05	1000	        4920	   5162
Frühschicht	29.5.17 08:14	29.5.17 23:25	2000	        0	   1916
Nachtschicht	29.5.17 23:38	30.5.17 04:47	3000	        0	   634
Nachtschicht	30.5.17 04:53	30.5.17 05:59	4000	        0	   758

Hier das ganze Schichtbezogen also Wert zu Schichtanfang und Ende

Frühschicht	29.5.17 06:00	29.5.17 13:59	1000	        4920	  1498
Spätschicht	29.5.17 14:00	29.5.17 21:59	2000	        1498	  1536
Nachtschicht	29.5.17 22:00	30.5.17 05:59	2000	        1536	  758
Das Problem dabei ist das neue Aufträge in der zwischenzeit starten und der zum Ende der Schicht gemessene Wert also nicht stimmt, bzw zwischenzeitig ja wieder von 0 gestartet ist und so werden Werte unterschlagen.
Eigentlich sieht es in den Schichten so aus (Differenzen der Start und Endwerte):

Differenzen           Differenz Summe
F 242 + 1498	 	1740
S 38			38
N 380 + 634 +  758	1772
Hier noch eine Beispiel-Datei: Für fragen stehe ich gerne offen.
https://www.herber.de/bbs/user/114152.xlsx

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Werte zwischen Uhrzeiten einer Schicht zuweisen
09.06.2017 13:18:34
yummi
Hallo Carsten,
was willst du denn jetzt noch zusätzlich darstellen?
Den jeweiligen Start und Endpunkt eines Auftrags? (datum + Zeit?)
Schick mal deine Datei mit dem Makro und den Daten, so wie du sie optimiert hast und sag welche Daten du noch für deien Auswertung braucht.
gruß
yummi
AW: Werte zwischen Uhrzeiten einer Schicht zuweisen
09.06.2017 13:28:16
Carsten
Hey yummi,
Habs jetzt so gemacht, weil wenn der Auftrag länger als eine Schicht geht splittet er mir das ja direkt weil er die 1 in der Schichtwechselspalte sieht.
Function Auswerten()
Dim llastD, llastS As Long
Dim i As Long
Dim zeileD As Long
zeileD = 2
llastS = Range("A" & Rows.Count).End(xlUp).Row
Debug.Print llastS
For i = 3 To llastS + 1
        If ActiveSheet.Cells(i, 20).Value = 1 Or ActiveSheet.Cells(i, 47).Value = 1 Then
Select Case ActiveSheet.Cells(i, 44).Value
Case "F":
ThisWorkbook.Sheets("Zusammenfassung").Cells(zeileD, 1).Value = "Frühschicht"
Case "S":
ThisWorkbook.Sheets("Zusammenfassung").Cells(zeileD, 1).Value = "Spätschicht"
Case "N":
ThisWorkbook.Sheets("Zusammenfassung").Cells(zeileD, 1).Value = "Nachtschicht"
Case Else
MsgBox "Letzte Zeile: " & i
End Select
'Zeit + Auftrag schreiben
ThisWorkbook.Sheets("Zusammenfassung").Cells(zeileD, 2).Value = ActiveSheet.Cells(i, _
1).Value
ThisWorkbook.Sheets("Zusammenfassung").Cells(zeileD, 4).Value = ActiveSheet.Cells(i, _
5).Value
'Startwerte schreiben
ThisWorkbook.Sheets("Zusammenfassung").Cells(zeileD, 5).Value = ActiveSheet.Cells(i, _
9).Value
ThisWorkbook.Sheets("Zusammenfassung").Cells(zeileD, 7).Value = ActiveSheet.Cells(i, _
12).Value
ThisWorkbook.Sheets("Zusammenfassung").Cells(zeileD, 9).Value = ActiveSheet.Cells(i, _
17).Value
ThisWorkbook.Sheets("Zusammenfassung").Cells(zeileD, 11).Value = ActiveSheet.Cells( _
i, 18).Value
If i  3 Then
'endwerte schreiben
ThisWorkbook.Sheets("Zusammenfassung").Cells(zeileD - 1, 6).Value = ActiveSheet. _
Cells(i - 1, 9).Value
ThisWorkbook.Sheets("Zusammenfassung").Cells(zeileD - 1, 8).Value = ActiveSheet. _
Cells(i - 1, 12).Value
ThisWorkbook.Sheets("Zusammenfassung").Cells(zeileD - 1, 10).Value =  _
ActiveSheet.Cells(i - 1, 17).Value
ThisWorkbook.Sheets("Zusammenfassung").Cells(zeileD - 1, 12).Value =  _
ActiveSheet.Cells(i - 1, 18).Value
ThisWorkbook.Sheets("Zusammenfassung").Cells(zeileD - 1, 3).Value = ActiveSheet. _
Cells(i - 1, 1).Value
End If
zeileD = zeileD + 1
End If
Next i
End Function

Den Start sowie endpunkt habe ich mir jetzt noch aus den Daten holen lassen etc. :)
Nicht wundern das ich überall "ThisWorkbook.Sheets("Zusammenfassung")" habe irgendwie bekomm ich anderweitig nen Error. Aber stört ja nicht so sehr. :D
Anzeige
AW: Werte zwischen Uhrzeiten einer Schicht zuweisen
09.06.2017 13:45:26
yummi
Hallo Carsten,
wenn du in der Initialiere Funktion schreibst

Set wkb = ThisWorkbook
Set wksD = wkb.Sheets("Zusammenfassung")
Natürlich muss die Variable auch ausserhalb der Funktion definiert sein.
Dim wkb as Workbook
Dim wksD as Worksheet
und die Funktion Initialiesere musst Du einmal am Anfang aufrufen, dann kriegst Du auch keien Error.
Dann kannst Du überall wo Du ThisWorkbook.Sheets(Zusammenfassung") stehen hast dies durch wksD ersetzen ;-)
Also hast Du jetzt alle infos die du braucht und es läuft alles?
Gruß
yummi
Anzeige
AW: Werte zwischen Uhrzeiten einer Schicht zuweisen
12.06.2017 08:36:36
Carsten
Danke für den Hinweis. Klappt jetzt auch so:
Function Auswerten()
Dim llastD, llastS As Long
Dim i As Long
Dim zeileD As Long
zeileD = 2
llastS = Range("A" & Rows.Count).End(xlUp).Row
Debug.Print llastS
For i = 3 To llastS + 1
If ActiveSheet.Cells(i, 20).Value = 1 Or ActiveSheet.Cells(i, 47).Value = 1 Then
Select Case ActiveSheet.Cells(i, 44).Value
Case "F":
wksD.Cells(zeileD, 1).Value = "Frühschicht"
Case "S":
wksD.Cells(zeileD, 1).Value = "Spätschicht"
Case "N":
wksD.Cells(zeileD, 1).Value = "Nachtschicht"
Case Else
Debug.Print "Letzte Zeile: " & i
End Select
'Zeit + Auftrag schreiben
wksD.Cells(zeileD, 2).Value = ActiveSheet.Cells(i, 1).Value
wksD.Cells(zeileD, 4).Value = ActiveSheet.Cells(i, 5).Value
'Startwerte schreiben
wksD.Cells(zeileD, 5).Value = ActiveSheet.Cells(i, 9).Value
wksD.Cells(zeileD, 7).Value = ActiveSheet.Cells(i, 12).Value
wksD.Cells(zeileD, 9).Value = ActiveSheet.Cells(i, 17).Value
wksD.Cells(zeileD, 11).Value = ActiveSheet.Cells(i, 18).Value
If i  3 Then
'endwerte schreiben
wksD.Cells(zeileD - 1, 6).Value = ActiveSheet.Cells(i - 1, 9).Value
wksD.Cells(zeileD - 1, 8).Value = ActiveSheet.Cells(i - 1, 12).Value
wksD.Cells(zeileD - 1, 10).Value = ActiveSheet.Cells(i - 1, 17).Value
wksD.Cells(zeileD - 1, 12).Value = ActiveSheet.Cells(i - 1, 18).Value
wksD.Cells(zeileD - 1, 3).Value = ActiveSheet.Cells(i - 1, 1).Value
End If
zeileD = zeileD + 1
End If
Next i
End Function
Das einzige was ich jetzt noch machen möchte ist, dass wenn jedes Mal wenn ich das Makro ausführe er nen neues Blatt Zusammenfassung+INDEX i also z.B. Zusammenfassung2 etc. erstellt. und hinter dem anderen Zusammenfassung anordnet. :)
Gruß
Anzeige
AW: Werte zwischen Uhrzeiten einer Schicht zuweisen
12.06.2017 08:52:06
yummi
Hallo Carsten,
kannst du so machen:

Function NeuesSheet()
'** einfügen als letztes Blatt
'** Dimensionierung der Variablen
Dim BlattName As String
Dim bloFlg As Boolean
'** Blattname festlegen
BlattName = "Zusammenfassung"
BlattName  = PruefeBlattname BlattName
'** Blatt nur einfügen, wenn noch nicht vorhanden
If BlattName  "" Then
With ThisWorkbook
.Sheets.Add after:=Sheets(Worksheets.Count)
.ActiveSheet.Name = Blattname
End With
End If
End function
function PruefeBlattname (ByVal strName as String) as string
'** Prüfen, ob das Blatt, welches eingefügt werden soll bereits vorhanden ist
Dim blatt As Object
dim i as integer
i = 1
For Each blatt In Sheets
If blatt.Name = strName & i Then
i= i +1
Next blatt
PruefeBlattname = strName & i
end function
Jetzt musst Du in deinem bestehenden Code nur noch NeuesSheet aufrufen und fertig.
Gruß
yummi
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige