Office: (Office 2007) Tag in 15-Minuten Intervalle aufteilen

Roland1983 · 8. April 2008

Hallo zusammen,

ich habe ein Problem: Und zwar habe ich ein Makro verfasst, dass einen Tag von 09:00:00 bis 17:30:00 in 15 Min Intervalle (34 Intervalle) einteilt (also das erste Intervall von 09:00:00 bis 09:14:59, das zweite von 09:15:00 bis 09:29:59 etc). Jetzt zum Problem von meinem Makro: an den Schnittstellen der Intervalle ordnet das Makro die Intervalle falsch zu, außerdem ist es sehr langsam. Könnt ihr mir helfen, wie ich das Makro anpassen und verbessern könnte?

Zu den Rahmendaten: Habe Excel 2007, in der zweiten Spalte ist die Uhrzeit, in der dritten Spalte nochmal die Uhrzeit, allerdings umgewandelt in das Zahlenformat (also 09:00 ist 0,375000000000000 etc.). Die Intervallnummer steht in der 10 Spalte.

Könnt ihr mir hier weiterhelfen? Vielen Dank im Voraus.
Viele Grüße, Roland

Code:

Sub ZaehleIntervalle()

Dim intervallnummer As Integer
Dim i As Integer
Dim lastrow As Integer

Worksheets("Tabelle1").Activate
ActiveSheet.Cells(1, 10).Value = "Intervallnummer"
lastrow = ActiveSheet.Cells(1, 1).End(xlDown).Row

For i = 2 To lastrow

intervallnummer = 0

For j = 0 To 36

If ActiveSheet.Cells(2 + i, 3) >= 0.375 + 1.04166666666667E-02 * j And ActiveSheet.Cells(2 + i, 3) < 0.375 + 1.04166666666667E-02 * (j + 1) Then
intervallnummer = j

End If

Next j

Cells(2 + i, 10) = intervallnummer
Next i

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

:)

EarlFred · 10. April 2008

Hallo Roland,

die Umrechung der Uhrzeiten in Dezimalzahlen und das Rechnen mit diesen würde ich mir verkneifen, da Excel durchaus mit Uhrzeiten rechnen kann.

Habe mal einen "Gegenvorschlag" geschrieben:

Code:

Sub Intervalle_testen()
lz = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lz
Cells(i, 10) = WorksheetFunction.RoundDown((Cells(i, 2) - TimeValue("09:00:00")) / TimeValue("00:15:00"), 0)
Next i
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Bei dem Versuch, das Ergebnis als Ganzzahl (INT) ausgeben zu lassen, scheint Excel an die Grenzen der Rechengenauigkeit zu stoßen, da hin und wieder ein falsches Intervall zurückgegeben wird.
Mit Rounddown habe ich aber keine Abweichungen im Grenzbereich festgestellt.

[Ergänzung]
Habe beide Makros grad mal mit rund 60.000 Datensätzen probiert: 1 Minute zu 8 Sekunden. Schnell genug? *wink.gif*
[/Ergänzung]

Grüße
EarlFred

Styrkar · 10. April 2008

Hi,

da war Earl etwas schneller, aber zumindest ist meine Version nicht so langsam *wink.gif*

Code:

Sub ZaehleIntervalle()
Dim i As Long
Dim lastrow As Long
Dim iFeld

With Worksheets("Tabelle1")
.Range("J1").Value = "Intervallnummer"
lastrow = .Cells(2, 1).End(xlDown).Row
iFeld = .Range("B2:B" & lastrow)

For i = LBound(iFeld, 1) To UBound(iFeld, 1)
iFeld(i, 1) = WorksheetFunction.RoundDown(((CDate(iFeld(i, 1)) - TimeSerial(9, 0, 0))) / TimeSerial(0, 15, 0) + 1, 0)
Next

.Range("J2:J" & lastrow) = iFeld
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

EarlFred · 10. April 2008

\@Styrkar,
stimmt, ein Array bringt nochmals Schwung in die Kiste *wink.gif*

Rounddown ist aber echt beser, gelle? *wink.gif*

Grüße
EarlFred

Roland1983 · 10. April 2008

Super, klappt wunderbar! Vielen Dank euch beiden!

Roland1983 · 9. Mai 2008

Hi, jetzt habe ich noch eine Frage: Wie kann ich das zweite Makro noch umwandeln, damit es anstatt für "Tabelle1" bei jedem aktiven worksheet in der Arbeitsmappe funktioniert (also ohne explizit einen Namen in das Makro einzutragen)?

Viele Dank und Grüße, Roland

Roland1983 · 10. Mai 2008

also ich will eigentlich das makro in eine schleife einbinden, damit die intervallnummern für jedes sheet in der arbeitsmappe berechnet werden...habs mal folgendermaßen probiert, aber es kommen immer fehlermeldungen Code:

Sub Schleife3()
Dim tabelle As Worksheet
Application.ScreenUpdating = False

For Each tabelle In ActiveWorkbook.Worksheets

Dim i As Long
Dim lastrow As Long
Dim iFeld
Dim tabelle2 As Worksheet
With tabelle2
.Range("J1").Value = "Intervallnummer"
lastrow = Cells(2, 1).End(xlDown).Row
iFeld = Range("B2:B" & lastrow)

For i = LBound(iFeld, 1) To UBound(iFeld, 1)
iFeld(i, 1) = WorksheetFunction.RoundDown(((CDate(iFeld(i, 1)) - TimeSerial(9, 0, 0))) / TimeSerial(0, 15, 0) + 1, 0)
Next

.Range("J2:J" & lastrow) = iFeld
End With

Next tabelle

Set tabelle = Nothing
Application.ScreenUpdating = True

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wie kann ich den Code abändern ?

EarlFred · 10. Mai 2008

Hallo Roland,

mit diesem "Innenleben" sollte es klappen:

Code:

For Each Tabelle In ActiveWorkbook.Worksheets
With Tabelle
.Range("J1").Value = "Intervallnummer"
lastrow = .Cells(2, 1).End(xlDown).Row
iFeld = .Range("B2:B" & lastrow)

For i = LBound(iFeld, 1) To UBound(iFeld, 1)
iFeld(i, 1) = WorksheetFunction.RoundDown(((CDate(iFeld(i, 1)) - TimeSerial(9, 0, 0))) / TimeSerial(0, 15, 0) + 1, 0)
Next

.Range("J2:J" & lastrow) = iFeld
End With
Next Tabelle
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Grüße
EarlFred

Roland1983 · 14. Mai 2008

Hi, danke schon mal für deine Hilfe, aber bei der Zeile gibts nach wie vor Probleme:
iFeld(i, 1) = WorksheetFunction.RoundDown(((CDate(iFeld(i, 1)) - TimeSerial(9, 0, 0))) / TimeSerial(0, 15, 0) + 1, 0)

hab mal eine Testmappe angehängt...

Danke & Gruß,

Roland

EarlFred · 14. Mai 2008

Moin Roland,

habe kein Excel 2007 und mir die Mappe daher ins Excel-2003-Format konvertiert (ohne Makros). Mit diesem Code im Hintergrund läuft das ganze rund:

Code:

Option Explicit

Sub Schleife3()
Dim Tabelle As Worksheet
Dim lastrow&, i&
Dim iFeld()

For Each Tabelle In ActiveWorkbook.Worksheets
With Tabelle
.Range("J1").Value = "Intervallnummer"
lastrow = .Cells(2, 1).End(xlDown).Row
iFeld = .Range("B2:B" & lastrow)

For i = LBound(iFeld, 1) To UBound(iFeld, 1)
iFeld(i, 1) = WorksheetFunction.RoundDown(((CDate(iFeld(i, 1)) - TimeSerial(9, 0, 0))) / TimeSerial(0, 15, 0) + 1, 0)
Next

.Range("J2:J" & lastrow) = iFeld
End With
Next Tabelle

Set Tabelle = Nothing
Application.ScreenUpdating = True
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Sag doch mal, wo genau es hakt, denn Deine Aussage "aber bei der Zeile gibts nach wie vor Probleme" kann ich nicht bestätigen.

Grüße
EarlFred

Roland1983 · 14. Mai 2008

Hi EarlFred,

also das Makro schreibt auf das erste Blatt noch "intervallnummer" in die Zelle "J1", aber es kommt im Anschluß :

Laufzeitfehler'13': Typen unverträglich

Wenn ich dann auf "Debuggen" klicke, markiert er folgende Zeile:

iFeld(i, 1) = WorksheetFunction.RoundDown(((CDate(iFeld(i, 1)) - TimeSerial(9, 0, 0))) / TimeSerial(0, 15, 0) + 1, 0)

Das komische ist, nur in der Schleife funktioniert das Makro nicht, wenn ich es nur für ein Tabellenblatt verwende, geht es...

Viele Grüße,

Roland

Roland1983 · 14. Mai 2008

hm...komisch

dein neues Makro funktioniert jetzt doch bei der Testdatei....aber bei meiner großen Datei mit mehr als 30 Sheets und deutlich mehr Zeilen kommt der besagte Fehler...

EarlFred · 14. Mai 2008

Hallo Roland,

Edit:
OK, meine eigentliche Rückfrage hast Du damit mittlerweile beantwortet.

Dann bleibt nur noch die Frage, ob sich das Makro bei einem ungültigen Wert "verschluckt": CDate() kann nur gültige Datumsausdrücke konvertieren - ansonsten kommt der von Dir genannte Fehler.

Ich habe mal eine schnelle Fehlerbehandlungsroutine hinzugefügt, so dass bei ungültigen Uhrzeiten eine "-35" ausgeworfen wird. Nach diesen Werten kannst Du dann in Spalte J suchen und schauen, ob mit der Uhrzeit in Spalte B in besagter Zeile irgendetwas nicht stimmt.

Code:

Option Explicit

Sub Schleife3()
Dim Tabelle As Worksheet
Dim lastrow&, i&
Dim iFeld()

For Each Tabelle In ActiveWorkbook.Worksheets
With Tabelle
.Range("J1").Value = "Intervallnummer"
lastrow = .Cells(2, 1).End(xlDown).Row
iFeld = .Range("B2:B" & lastrow)

For i = LBound(iFeld, 1) To UBound(iFeld, 1)
On Error GoTo err_handler
iFeld(i, 1) = WorksheetFunction.RoundDown(((CDate(iFeld(i, 1)) - TimeSerial(9, 0, 0))) / TimeSerial(0, 15, 0) + 1, 0)
Next

.Range("J2:J" & lastrow) = iFeld
End With
Next Tabelle

Set Tabelle = Nothing
Application.ScreenUpdating = True
Exit Sub

err_handler:
If Err.Number = 13 Then
iFeld(i, 1) = 0
Resume
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

/Edit

Grüße
EarlFred

Roland1983 · 15. Mai 2008

wow, es funktioniert
*biggrin.gif*

stimmt, bei einigen Zeilen war in der Uhrzeitspalte gar kein Wert drin, das wirds gewesen sein...
in der testdatei, die ich hochgeladen hab, waren in der Spalte "B" überall Uhrzeit-Werte drin, deswegen hat das Makro wohl da problemlos geklappt.

möcht mich nochmal ganz herzlich bei dir bedanken, dass du dir Zeit genommen hast und mir geholfen hast!

Viele Grüße und einen schönen Tag noch,

Roland

EarlFred · 15. Mai 2008

Hi Roland,

na wunderbar, dann haben wir den "Übeltäter" ja dingfest gemacht *biggrin.gif*

Gern geschehen!

Grüße
EarlFred

Office: (Office 2007) Tag in 15-Minuten Intervalle aufteilen

Tag in 15-Minuten Intervalle aufteilen

Tag in 15-Minuten Intervalle aufteilen

Tag in 15-Minuten Intervalle aufteilen

Tag in 15-Minuten Intervalle aufteilen

Tag in 15-Minuten Intervalle aufteilen

Tag in 15-Minuten Intervalle aufteilen - Similar Threads - Tag Minuten Intervalle

Serienbrief, Datum plus 7 Tage

Bestimmte Mail automatisch nach X Tagen löschen

Anzahl Tage berechnen, inclusiv Startdatum

Differenz zwischen Daten - Anzeige in Tage/Stunden/Minuten

Zeitdifferenz mit Tagen, Stunden, Minuten darstellen

Datediff im Format Tag, Stunden, Minuten, Sekunden

Excel Tage (8 Stunden Tage), Stunden, Minuten berechnen