Hallo zusammen,
ich habe in einer vorgegebenen Datei bei der die Anfangs-und Endzeiten in einer Spalte stehen. Diese Zeiten möchte ich nun per Makro Trennen (nach dem ersten Leerzeichen), so das die Anfangs und die Endzeit in verschiedenen Spalten im Urzeitformat stehen.
Das funktioniert auch schon. Nun würde ich die getrennten Zeiten aber gerne auf den Tabellenblatt "Tabelle2" unter dem entsprechendem Datum ausgegeben haben. Des Weiteren sollen Zellen die Buchstaben enthalten nicht mit übertragen werden. Könnt ihr mir hier eventuell helfen?
Ich habe eine Musterdatei angehängt, da es so etwas verständlicher ist.
Vielen Dank und Gruß Mario
Hallo Mario,
teste mal. Ist nicht der schnellste Code, aber ich Denke da werden sowieso noch weitere Fragen kommen.
Dann kann man ja schauen, ob man etwas schnelleres programmiert.
Code:
Private Sub CommandButton1_Click()
Dim i As Long, j As Long, k As Long
Dim lngLastR As Long
Dim lngLastC As Long
With Sheets("Tabelle2")
lngLastR = .Cells(Rows.Count, 1).End(xlUp).Row + 1
lngLastC = .Cells(3, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(4, 1), .Cells(lngLastR, lngLastC)).ClearContents
End With
lngLastR = Cells(Rows.Count, 1).End(xlUp).Row
lngLastC = Cells(10, Columns.Count).End(xlToLeft).Column
With Sheets("Tabelle2")
For i = 12 To lngLastR
For j = 5 To lngLastC
If Weekday(Cells(10, j), vbMonday) < 6 Then
If InStr(1, Cells(i, j).Value, " ") Then
.Cells(i - 8, j - 4 + k).Value = Split(Cells(i, j).Value)(0)
.Cells(i - 8, j - 4 + k + 1).Value = Split(Cells(i, j).Value)(1)
End If
End If
k = k + 1
Next j
k = 0
Next i
End With
End Sub
Hallo Mario,
die vorige Lösung war doch sehr langsam, deshalb hier doch noch eine Ratz Fatz Lösung:
Code:
Private Sub CommandButton1_Click()
Dim i As Long, j As Long, k As Long, n As Long
Dim lngLastR As Long
Dim lngLastC As Long
Dim varFeld
Dim arr()
With Sheets("Tabelle2")
lngLastR = .Cells(Rows.Count, 1).End(xlUp).Row + 1
lngLastC = .Cells(3, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(4, 1), .Cells(lngLastR, lngLastC)).ClearContents
End With
lngLastR = Cells(Rows.Count, 1).End(xlUp).Row
lngLastC = Cells(10, Columns.Count).End(xlToLeft).Column
varFeld = Range(Cells(10, 5), Cells(lngLastR, lngLastC))
ReDim arr(lngLastR - 12, (lngLastC - 4) * 2)
With Sheets("Tabelle2")
For i = 1 To lngLastR - 11
For j = 1 To lngLastC - 5
If Weekday(varFeld(1, j), vbMonday) < 6 Then
If InStr(1, varFeld(i + 2, j), " ") Then
arr(n, k) = Split(varFeld(i + 2, j))(0)
arr(n, k + 1) = Split(varFeld(i + 2, j))(1)
End If
End If
k = k + 2
Next j
k = 0
n = n + 1
Next i
.Range("A4").Offset(0, 0).Resize(n, (lngLastC - 4) * 2) = arr
End With
End Sub
Hallo Atilla,
das funktioniert super :28:.
Ich danke dir. Spitze wie immer!
VG Mario