Hallo,
ich hab da ein Problem zu einem bestehenden Code.Bisher funktioniert das Makro wunderbar, nur soll jetzt in Zeile:
If Hour(fAuslesen(i, 1)) >= 0 And Hour(fAuslesen(i, 1)) <= 24 Then
die Uhrzeit geändert werden. nicht von 0 bis 24 Uhr, sondern von 00:00 bis 00:30. Leider bekomme ich dann alle Werte mit 0, also von 00:00 bis 00:59 Uhr. Wenn ich die Uhrzeit so schreibe 00:00:00 bringt er mir einen Fehler. Die Ausgangszelle sieht übringens so aus: 04.06.2012 00:03:13. Und dann kommen im 8 Minutenschritt weitere hinzu.
Hat hier jemand eine Idee??
Gruß Robert
Sub HalbeStunde()
Dim fAuslesen() As Variant
Dim fÜbergabe() As Variant
Dim i As Long
Dim j As Long
Dim strTag As String
Dim dSpalte As Double
Sheets("Tabelle3").Select
Cells.Select
Selection.ClearContents
With Sheets("Tabelle2")
fAuslesen = Range(.Range("A2"), .Range("A2").End(xlDown)).Resize(, 3)
End With
ReDim fÜbergabe(1 To UBound(fAuslesen), 1 To 3)
For i = 1 To UBound(fAuslesen)
If Hour(fAuslesen(i, 1)) >= 0 And Hour(fAuslesen(i, 1)) <= 24 Then
' Datum merken - strTag ist beim Start leer
If strTag = "" Then strTag = Left(fAuslesen(i, 1), 4)
' Datum vergleichen - mit dem was aktuell als Wert eingetragen werden soll
If strTag <> Left(fAuslesen(i, 1), 4) Then
' wenn es ein anderes Datum ist das neue merken
strTag = Left(fAuslesen(i, 1), 4)
' damit er auch in Spalte 1 anfängt
If Cells(1, Columns.Count).End(xlToLeft).Column + 1 = 2 Then
dSpalte = 1
Else
' danach immer die nächste freie Spalte nehmen
dSpalte = Cells(1, Columns.Count).End(xlToLeft).Column + 1
End If
'Im array stehen nur Daten vom selben Tag und das fügen ein
Sheets("Tabelle3").Cells(1, dSpalte).Resize(j, 3) = fÜbergabe
j = 0
Erase fÜbergabe
ReDim fÜbergabe(1 To UBound(fAuslesen), 1 To 3)
End If
j = j + 1
fÜbergabe(j, 1) = fAuslesen(i, 1)
fÜbergabe(j, 2) = fAuslesen(i, 2)
fÜbergabe(j, 3) = fAuslesen(i, 3)
End If
Next i
Sheets("Tabelle3").Cells(1, Cells(1, Columns.Count).End(xlToLeft).Column + 1).Resize(j, 3) = fÜbergabe
Cells.Select
Cells.EntireColumn.AutoFit
End Sub
|