Das Clever-Excel-Forum.de - Treffen
findet vom 15. - 17. September 2017 in Thüringen / Region Großer Inselsberg statt. Hotelbuchung ab sofort möglich.


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)
to 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

Excel 2007
[-] Folgende(r) 1 Benutzer sagt Danke an atilla für diesen Beitrag:
Mario
to 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

Excel 2007
[-] Folgende(r) 1 Benutzer sagt Danke an atilla für diesen Beitrag:
Mario
to top
#4
Hallo Atilla,

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

VG Mario
to top


Möglicherweise verwandte Themen...
Thema Verfasser Antworten Ansichten Letzter Beitrag
  Hyperlink Funktion bei Leerzeichen waldemarrrrr 2 41 29.11.2016, 22:47
Letzter Beitrag: waldemarrrrr
  Werte aus Blatt 1 nach Passworteingabe in Blatt 2 übertragen Atila2016 23 379 28.10.2016, 11:09
Letzter Beitrag: schauan
  Leerzeichen aus Zahlen-Text Mischung entfernen? Franzi 79 2 59 19.10.2016, 14:50
Letzter Beitrag: Franzi 79
  Postleitzahl von Ort trennen Serpent Driver 23 333 14.10.2016, 09:59
Letzter Beitrag: snb
  Sortierung mehrerer Zeilen nach Größe einer bestimmten Zelle Godman2 8 211 05.10.2016, 18:30
Letzter Beitrag: schauan
  inhalt einer Textbox ohne leerzeichen und mit einer o vorne dran kraehenseele 4 205 11.09.2016, 01:28
Letzter Beitrag: kraehenseele
  Nach Inhalt Zelle filtern D K 5 289 26.07.2016, 19:24
Letzter Beitrag: schauan
  Textauswahl in der TextBox bis zum vorigen und nächsten Leerzeichen ergänzen VBATartar 10 651 21.07.2016, 13:50
Letzter Beitrag: Quantum
  Werte auf kleinste/größte Werte einer anderen Spalte zuordnen MaxiL 2 233 21.07.2016, 10:24
Letzter Beitrag: MaxiL
  Positionen von Leerzeichen bestimmen VBATartar 3 268 01.07.2016, 11:05
Letzter Beitrag: VBATartar

Gehe zu:


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