Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Werte in Zelle nach Leerzeichen per VBA Trennen
#1
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


Angehängte Dateien
.xls   Arbeitszeiten.xls (Größe: 53 KB / Downloads: 5)
Antwortento top
#2
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
Gruß Atilla
[-] Folgende(r) 1 Benutzer sagt Danke an atilla für diesen Beitrag:
  • Mario
Antwortento top
#3
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
Gruß Atilla
[-] Folgende(r) 1 Benutzer sagt Danke an atilla für diesen Beitrag:
  • Mario
Antwortento top
#4
Hallo Atilla,

das funktioniert super 28.
Ich danke dir. Spitze wie immer!

VG Mario
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste