Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
24.04.2024 17:19:09
Anzeige
Archiv - Navigation
1012to1016
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zeilendaten aufteilen

Zeilendaten aufteilen
30.09.2008 11:27:57
Eddie
Hallo, ich habe folgendes Problem,
ich habe einen ganzen Batzen von Daten, die ich gerne in Excel importieren möchte, nur leider fügt er mir die Daten etwas blöd ein.
IST
Zelle A1
xxblabl idgdhgjdh; /* blabla*/
SOLL
Zelle A1
xxblabl
Zelle B1
idgdhgjdh;
Zelle C1
/* blabla*/
Ich bräuchte ein Makro, was einfach nur schaut, ob min. 2 Leerzeichen zwischen den Texten vorhanden sind ... und wenn ja soll er die Lerrzeichen löschen und den Rest in die nächste Spalte verschieben und das so lange bis halt alles in einzelne Spalten ist, und nicht nur eine Zelle
Außerdem sollte das Makro dann bis zur letzten Zeile das erledigen
Thx schon einmal und an alle guten HUNGER :-)
gruß Eddie

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeilendaten aufteilen
30.09.2008 11:52:04
JogyB

Sub aufTeilen()
Dim i As Long
Dim tempStr() As String
For i = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
tempStr = Split(ActiveSheet.Cells(i, 1).Value, "  ")
ActiveSheet.Range(Cells(i, 1), Cells(i, UBound(tempStr) + 1)).Value = tempStr
Next
End Sub

Gruss, Jogy

AW: Zeilendaten aufteilen
30.09.2008 12:18:00
JogyB
Nachtrag: Das schaut jetzt nach exakt zwei Leerzeichen. Wenn es auch mal mehr sind, dann würde das mit folgendem Code klappen:

Sub aufTeilen()
Dim i As Long
Dim j As Long
Dim tempStr() As String
Dim zeLLe As Range
' Bildschirmupdate aus
Application.ScreenUpdating = False
' Geht von erster bis letzter Zeile
For i = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
' Teilt nach Doppelleerzeichen auf (diese werden dabei gelöscht)
tempStr = Split(ActiveSheet.Cells(i, 1).Value, "  ")
' Schreibt die Werte
ActiveSheet.Range(Cells(i, 1), Cells(i, UBound(tempStr) + 1)).Value = tempStr
' Alle Zelle überprüfen, dazu Speicher für zu löschende Zelle
' Nicht mit For..Each, da von hinten nach vorne
For j = UBound(tempStr) + 1 To 1 Step -1
Set zeLLe = ActiveSheet.Cells(i, j)
' Wenn Zelle nicht leer
If Len(zeLLe.Value) > 0 Then
' Auf Leerzeichen am Anfang prüfen und diese löschen
While Left(zeLLe.Value, 1) = " "
zeLLe.Characters(1, 1).Delete
Wend
End If
' Nochmals auf leere Zelle prüfen (könnte jetzt leer sein, da vorher nur  _
Leerzeichen)
If Len(zeLLe.Value) = 0 Then
zeLLe.Delete (xlShiftToLeft)
End If
Next
Next
' Bildschirmupdate wieder ein
Application.ScreenUpdating = True
End Sub


Gruss, Jogy

Anzeige
DANKE
30.09.2008 12:34:00
Eddie
Danke .. klappt bis jetzt einwandfrei deine 2te Variante
gruß Eddie

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige