Zahlen aus String - etwas anders | HERBERS Excel Forum

Hallo zusammen,
Gern möchte ich aus dem gemischten Zellinhalt meiner Tabellenüberschriften nach den möglichen Mustern "Text Zahl Text" oder auch "Zahl Text Text" oder "Text Text Zahl" oder oder oder... diesen in seine Bestandteile zerlegen und jedes Bestandteil des Strings in einer neuen Zeile ausgeben.
Würde dann so aussehen:
Zeile 1 der numerische Teil
Zeile 2-4 evtl. auch 5 der zerlegte Text
Prinzipiell tut mein Code schon was er soll, nur fehlt es mir an der korrekten Sortierung. Wenn der Ur-String eine andere Reihenfolge hat als "Text Zahl Text" bekomme ich logischerweise in der 1. Zeile nicht den numerischen Teil ausgegeben, sondern Text. Wie kann ich den ausgelesenen String auf Zahlen prüfen und diese immer in der 1. Zeile in der Ausgabespalte aufführen? Falls das die Sache erleichtert, es ist IMMER eine 5-stellige Zahl.
Würde mich freuen, wenn da jemand helfen kann.
Hier noch mein Codeschnipsel, den ich mir schon zusammengegangstert habe... Falls sich da jemand wiedererkennt, dann sag ich schon mal Danke! ;)
Sorry für die blöden Bezichnungen der Variablen. Ich dachte das bekommt nie jemand zu Gesicht.
On Error Resume Next 'BEGINN Spaltenüberschriften separieren
strSep = " "
letztespalte = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column
erste = Cells(1, 1).End(xlDown).Row + 1
For spalte = 1 To letztespalte
strText = Cells(erste, spalte).Text
If strText "" Then
strText = Trim(strText)
Cells(1, spalte) = Trim(Split(strText, strSep)(2))
Cells(2, spalte) = Trim(Split(strText, strSep)(1))
Cells(3, spalte) = Trim(Split(strText, strSep)(0))
Cells(4, spalte) = Trim(Split(strText, strSep)(3))
End If
Next 'ENDE Spaltenüberschriften separieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

dim Texte as string dim Zahlen as string dim T strText = trim(strText) for each T in Split(strText, strSep) if isnumeric(T) then Zahlen = Zahlen & T & strSep else Texte = Texte & T & strSep end if next if Zahlen = "" then Zahlen = strSep T = split(Zahlen & Texte, strSep) Cells(1, spalte).Resize(ubound(T) + 1, 1).value = Worksheetfunction.Transpose(T)

Sub Trennen() Dim LetzteSpalte As Long Dim Erste As Long Dim C As Long 'Column Dim Arr, i, j, k Const cSep = " " On Error Resume Next LetzteSpalte = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column Erste = Cells(1, 1).End(xlDown).Row + 1 For C = 1 To LetzteSpalte 'BEGINN Spaltenüberschriften separieren Arr = Split(Cells(Erste, C).Text, cSep) If UBound(Arr) > -1 Then j = 1 k = 1 For i = 0 To UBound(Arr) If IsNumeric(Arr(i)) Then Cells(j, C) = Trim(Arr(i)) j = j + 1 Else Cells(k, C) = Trim(Arr(i)) k = k - 1 End If Next End If Next 'ENDE Spaltenüberschriften separieren End Sub

Sub Trennen() Dim LetzteSpalte As Long Dim Erste As Long Dim C As Long 'Column Dim Arr, i, j, k Const cSep = " " On Error Resume Next LetzteSpalte = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column Erste = Cells(1, 1).End(xlDown).Row For C = 1 To LetzteSpalte 'BEGINN Spaltenüberschriften separieren Arr = Split(Cells(Erste, C).Text, cSep) If UBound(Arr) > -1 Then j = 1 k = UBound(Arr) + 1 For i = 0 To UBound(Arr) If IsNumeric(Arr(i)) Then Cells(j, C) = Trim(Arr(i)) j = j + 1 Else Cells(k, C) = Trim(Arr(i)) k = k - 1 End If Next End If Next 'ENDE Spaltenüberschriften separieren End Sub

Sub Durchlauf() Dim W As Worksheet For Each W In ActiveWorkbook.Worksheets Trennen W Next End Sub Sub Trennen(Blatt As Worksheet) Dim LetzteSpalte As Long Dim Erste As Long Dim C As Long 'Column Dim Arr, i, j, k Const cSep = " " On Error Resume Next With Blatt LetzteSpalte = .UsedRange.SpecialCells(xlCellTypeLastCell).Column Erste = .Cells(1, 1).End(xlDown).Row For C = 1 To LetzteSpalte 'BEGINN Spaltenüberschriften separieren Arr = Split(.Cells(Erste, C).Text, cSep) If UBound(Arr) > -1 Then j = 1 k = UBound(Arr) + 1 For i = 0 To UBound(Arr) If IsNumeric(Arr(i)) Then .Cells(j, C) = Trim(Arr(i)) j = j + 1 Else .Cells(k, C) = Trim(Arr(i)) k = k - 1 End If Next End If Next 'ENDE Spaltenüberschriften separieren End With End Sub

Sub test() Dim Spalte As Long Const strSep As String = " " Dim strText As String Dim Texte As String Dim Zahlen As String Dim T For Spalte = 4 To 82 strText = Cells(6, Spalte).Value strText = Trim(strText) Zahlen = "" Texte = "" For Each T In Split(strText, strSep) If IsNumeric(T) Then Zahlen = Zahlen & T & strSep Else Texte = Texte & T & strSep End If Next If Zahlen = "" Then Zahlen = strSep T = Split(Zahlen & Texte, strSep) Cells(1, Spalte).Resize(UBound(T) + 1, 1).Value = WorksheetFunction.Transpose(T) Next End Sub

Hallo Daniel, Ja das war ungeschickt beschrieben. Entschuldige bitte. Um es nochmal der Vollständigkeit halber genauer zu beschreiben, es ist gar nichts passiert beim ersten Versuch. Keine Veränderung auf dem Blatt. Jetzt im Zusammenhang funktioniert es einwandfrei. Vielen Dank nochmal. Mir ist dann auch noch eine Idee gekommen und die konnte ich soeben fertigstellen. Da muss man auch erstmal drauf kommen... Ich weiß, ihr ratet immer von dem Select-Befehl ab, aber ich bin immer froh wenns funktioniert. ;) Bitte nicht wundern, dass da jetzt überflüssige Variablen definiert sind. Im Makro passieren noch ein paar Sachen mehr.
Option explicit


Sub spalten ()
Dim i, letzte, lspalte  As Integer
Dim erste, start, anzahl, Zeile, Spalte, letztespalte As Long
Dim strTxt, strText, strSep As String
On Error Resume Next                                                'BEGINN Spaltenüberschriften separieren
strSep = " "
letztespalte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
erste = Cells(1, 1).End(xlDown).Row + 1
For Spalte = 1 To letztespalte
strText = Cells(erste, Spalte).Text
If strText  "" Then
strText = Trim(strText)
Cells(2, Spalte).Value = Trim(Split(strText, strSep)(0))
Cells(3, Spalte).Value = Trim(Split(strText, strSep)(1))
Cells(4, Spalte).Value = Trim(Split(strText, strSep)(2))
Cells(5, Spalte).Value = Trim(Split(strText, strSep)(3))
Range(Cells(1, Spalte), Cells(6, Spalte)).Select
Selection.NumberFormat = "@"
Selection.AutoFilter.Sort
With ActiveSheet.AutoFilter.Sort.SortFields.Clear
End With
ActiveSheet.AutoFilter.Sort. _
SortFields.Add2 Key:=Range(Cells(1, Spalte), Cells(6, Spalte)), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveSheet.AutoFilter.Sort
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.AutoFilter.Sort
End If
Next                                                              'ENDE Spaltenüberschriften separieren
End Sub

Die anderen teste ich auch gleich noch.
Habt nochmal alle vielen Dank. Das Problem ist definitiv gelöst.

Sub spalten () Dim i, letzte, lspalte As Integer Dim erste, start, anzahl, Zeile, Spalte, letztespalte As Long Dim strTxt, strText, strSep As String On Error Resume Next 'BEGINN Spaltenüberschriften separieren strSep = " " letztespalte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column erste = Cells(1, 1).End(xlDown).Row + 1 For Spalte = 1 To letztespalte strText = Cells(erste, Spalte).Text If strText "" Then strText = Trim(strText) Cells(2, Spalte).Value = Trim(Split(strText, strSep)(0)) Cells(3, Spalte).Value = Trim(Split(strText, strSep)(1)) Cells(4, Spalte).Value = Trim(Split(strText, strSep)(2)) Cells(5, Spalte).Value = Trim(Split(strText, strSep)(3)) Range(Cells(1, Spalte), Cells(6, Spalte)).Select Selection.NumberFormat = "@" Selection.AutoFilter.Sort With ActiveSheet.AutoFilter.Sort.SortFields.Clear End With ActiveSheet.AutoFilter.Sort. _ SortFields.Add2 Key:=Range(Cells(1, Spalte), Cells(6, Spalte)), SortOn:=xlSortOnValues, Order:= _ xlAscending, DataOption:=xlSortNormal With ActiveSheet.AutoFilter.Sort .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Selection.AutoFilter.Sort End If Next 'ENDE Spaltenüberschriften separieren End Sub

Beliebteste Forumthreads (12 Monate)

Zahlen aus String - etwas anders

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

38 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zahlen aus String - etwas anders

18 Beiträge zum Forumthread Beiträge zu diesem Forumthread

38 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread