Erstellen eines 24h Profiles

Hi Zusammen!
Ich hab folgendes Problem: Für meine Masterarbeit soll ich anhand Verkehrsdaten ein Tagesprofil erstellen. Hierfür habe ich eine automatische Auswertungstabelle via VBA programmiert, welche einen ganzen Tag (1-24h) darstellt. Von einer anderen Tabelle habe ich die Uhrzeiten (hh:mm:ss) übertragen un diese dann in Dezimalzahlen umgewandelt.
So weit so gut. Nun möchte ich aber die Uhrzeiten zu den Tageszeiten hinzufügen (8 = 8,66667 (8:40)).
Erster Ansatz wäre, ein if-Schleife die prüft, ob Dezimalzahl (tzZahl) größer oder gleich der Tageszeit ist. Funktioniert, jedoch istr in der ursprünglichen Reihenfolge dies schon gegeben und somit kein Unterschied.
Zweiter Ansatz ist eine if-Schleife, die nur die Stundenwerter (tzh = 8) kontrolliert und schaut, ob diese gleich zu den Uhrzeiten sind.
Danke im Voraus für eure Hilfe.
PS: gesamter Code folgt in den Antworten

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender


Sub Tagesprofil1()
Dim Zeile As Long
Dim ZeileMax As Long
Dim ZeileMAx1 As Long
Dim n As Long
Dim m As Long
Dim st1 As Long
Dim tz As Long
Dim tz1 As Long
Dim tzMax As Long
Dim tzUhr As Date
Dim tzh As Long
Dim tzm As Long
Dim tzs As Long
Dim tzh1 As Long
Dim tzm1 As Long
Dim tzs1 As Long
Dim tzZahl As Double
Dim tzZahl1 As Double
st1 = 1
tzMax = 24
With Tabelle11 'Tabelleninhalt vor Suche löschen.
ZelleMax = .UsedRange.ClearContents
With Tabelle12 'Wegetabelle
ZeileMax = .UsedRange.Rows.Count
n = 1
With Tabelle11 'Tagesprofil 1
ZeileMAx1 = .UsedRange.Rows.Count
m = 1
For Zeile = 1 To ZeileMax
If Tabelle12.Cells(Zeile, 3).Value = st1 Then
Tabelle12.Cells(Zeile, 11).Copy Destination:=Tabelle11.Cells(n, 2) 'Startzeitpunkt
Tabelle12.Cells(Zeile, 12).Copy Destination:=Tabelle11.Cells(n, 4) 'Startgemeinde
Tabelle12.Cells(Zeile, 34).Copy Destination:=Tabelle11.Cells(n, 6) 'Hauptverkehrsmittel
Tabelle12.Cells(Zeile, 36).Copy Destination:=Tabelle11.Cells(n, 3) 'Zielzeitpunkt
Tabelle12.Cells(Zeile, 37).Copy Destination:=Tabelle11.Cells(n, 5) 'Zielgemeinde
Tabelle12.Cells(Zeile, 42).Copy Destination:=Tabelle11.Cells(n, 7) 'Wegdauer
Tabelle12.Cells(Zeile, 44).Copy Destination:=Tabelle11.Cells(n, 8) 'Weglänge
n = n + 1
End If
Next Zeile
'Tageszeit 1 - 24 h
For tz = 1 To tzMax
Cells(tz, 1) = tz
'Startzeitpunkt
tzUhr = Tabelle11.Cells(tz, 2).Value
tzh = Format(tzUhr, "h") 'nur Stunden
tzm = Format(tzUhr, "n") 'nur Minuten
tzs = Format(tzUhr, "s") 'nur Sekunden
tzZahl = tzh + (tzm / 60) + (tzs / 60) 'Uhrzeit von hh:mm:ss in 0,00 umwandeln
Tabelle11.Cells(tz, 9) = tzZahl
'Ankunftszeitpunkt
tzUhr = Tabelle11.Cells(tz, 3).Value
tzh1 = Format(tzUhr, "h") 'nur Stunden
tzm1 = Format(tzUhr, "n") 'nur Minuten
tzs1 = Format(tzUhr, "s") 'nur Sekunden
tzZahl1 = tzh + (tzm / 60) + (tzs / 60) 'Uhrzeit von hh:mm:ss in 0,00 umwandeln
Tabelle11.Cells(tz, 10) = tzZahl1
Tabelle11.Cells(tz, 11) = tzh
If Tabelle11.Cells(tz, 1).Value = Tabelle11.Cells(tz, 11).Value Then
Tabelle11.Cells(tz, 9).Copy Destination:=Tabelle11.Cells(m, 2)
m = m + 1
End If
Next tz
End With
End With
End With
End Sub

'Wenn Tageszeit kleiner als Startzeit ist und wenn Tageszeit +1 größer ist asl Startzeit (Muss _ dazwischen liegen) -> 12 = tzZahl Then Tabelle11.Cells(tz, 9).Copy Destination:=Tabelle11.Cells(m, 12) m = m + 1 End If

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread