Das Clever-Excel-Forum.de - Treffen
findet vom 15. - 17. September 2017 in Friedrichroda /
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


...und ich gelobe Besserung...

[-] 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


...und ich gelobe Besserung...

[-] 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
  Zelle auswählen nach gesuchter zeile und gesuchter spalte Safety-Tussi 1 30 Vor 10 Stunden
Letzter Beitrag: atilla
  VBA nach Farben und Werte suchen? Klaus 13 363 10.02.2017, 20:03
Letzter Beitrag: Klaus
  Namen Trennen in neue Blätter AKGUSTI 18 401 06.02.2017, 12:50
Letzter Beitrag: AlterDresdner
  Zeiten Trennen in Verschiedene Spalten AKGUSTI 2 131 01.02.2017, 19:41
Letzter Beitrag: AKGUSTI
  2 Werte in einer Zelle MW1323 2 118 24.01.2017, 14:01
Letzter Beitrag: MW1323
  Werte in einer Zeile addieren bis Zielwert erreicht und verwendete Werte markieren hoteu 2 139 12.01.2017, 13:04
Letzter Beitrag: hoteu
  Werte aus verschiedenen Zellen auslesen und in einer Zelle eintragen Robbie1985 2 146 07.01.2017, 10:39
Letzter Beitrag: WillWissen
  Zeilen sortieren nach erstem Wert in Zelle seraphine 8 247 07.01.2017, 09:44
Letzter Beitrag: schauan
  Werte addieren/subtrahieren - je nach Bedingung Zweiundzwanzig 4 217 05.01.2017, 09:55
Letzter Beitrag: Zweiundzwanzig
  Leerzeichen zählen Lupy 25 631 04.01.2017, 20:28
Letzter Beitrag: snb

Gehe zu:


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