Mehrere Zahlen in einer Zelle extrahieren

[Horst Köhler]

Hallo an alle,

Ich möchte gerne eine Folge von Zahlen, die mit einem Leerzeichen voneinader
getrennt in einer Zelle stehen, separieren, und in eine Liste eintragen.

z.b. in Zelle A1 (Tabelle1) steht '14 19 3 7025 22 14458 38'

diese Werte möchte ich in die Spalte B (ab B2) auf Tabelle2 eintragen (wenn
möglich gleich aufsteigend sortiert).

(Das gleiche dann in den Zellen A2 bis A6, diese Werte sollen dann in die
Spalten C-G sortiert werden. Anschliessend sollen alle Werte noch mal in
Spalte A aufsteigend sortiert werden.)

Ich denke mal, dass das gar nicht so schwer ist, hab aber grade (seit
geraumer Zeit schon) ein Brett vorm Kopf. Ist das möglich, und wenn ja,
welche Funktion bietet sich dafür an?


Ach so:
Ich verwende Excel 2002

Gruß

Horst

[Jean Ruch]

Post by Horst Köhler
Hallo an alle,
Ich möchte gerne eine Folge von Zahlen, die mit einem Leerzeichen voneinader
getrennt in einer Zelle stehen, separieren, und in eine Liste
eintragen.
z.b. in Zelle A1 (Tabelle1) steht '14 19 3 7025 22 14458 38'
diese Werte möchte ich in die Spalte B (ab B2) auf Tabelle2 eintragen (wenn
möglich gleich aufsteigend sortiert).
(Das gleiche dann in den Zellen A2 bis A6, diese Werte sollen dann in die
Spalten C-G sortiert werden. Anschliessend sollen alle Werte noch mal in
Spalte A aufsteigend sortiert werden.)
Ich denke mal, dass das gar nicht so schwer ist, hab aber grade (seit
geraumer Zeit schon) ein Brett vorm Kopf. Ist das möglich, und wenn ja,
welche Funktion bietet sich dafür an?
Ich verwende Excel 2002
Gruß
Horst

Hallo Horst,

Benutze mal
aus dem Menüe Daten
die Funktion "Text in Spalten" / getrennt / weiter
Als Trennzeichen ein Druck auf die Leerzeichen -Taste
Danach benutze die Möglichkeit zum "Transponieren"
somit wäre das Schwierigste schon erledigt.

mit freundlichem Gruß

Jean

[Horst Köhler]

Benutze mal aus dem Menüe Daten
die Funktion "Text in Spalten" / getrennt / weiter
Als Trennzeichen ein Druck auf die Leerzeichen -Taste
Danach benutze die Möglichkeit zum "Transponieren"
somit wäre das Schwierigste schon erledigt.

Hallo,
das funktioniert, wenn ich einmalig den Zellinhalt extrhieren möchte.
Ich benötige das ganze aber dynamisch, d.h. sobald eine Gruppe Zahlen
eingegeben wird, sollen die einzelnen Zahlen extrahiert und in ein anderes
Tabellenblatt geschoben und sortiert werden. Als Makro kann ich das mit
deiner Version evtl lösen, aber ich dachte, dass das 'eleganter' (d. h. ohne
ein Makor) zu bewerkstelligen ist.
Falls ich doch zu einem Makro greifen muss, gleic eine Frage. Kann ich ein
Makro ausführen lasse, sobald ich eine Zelle verlasse? In diesem Fall würde
ich gerne nach dem Verlassen der Zellen, in die die Zahlenkolonnen stehen,
das 'Extrahiermakro' laufen lassen.

Gruß

Horst

[Jean Ruch]

Post by Horst Köhler
Hallo,
das funktioniert, wenn ich einmalig den Zellinhalt extrhieren möchte.
Ich benötige das ganze aber dynamisch, d.h. sobald eine Gruppe Zahlen
eingegeben wird, sollen die einzelnen Zahlen extrahiert und in ein anderes
Tabellenblatt geschoben und sortiert werden. Als Makro kann ich das mit
deiner Version evtl lösen, aber ich dachte, dass das 'eleganter' (d. h. ohne
ein Makor) zu bewerkstelligen ist.
Falls ich doch zu einem Makro greifen muss, gleic eine Frage. Kann ich ein
Makro ausführen lasse, sobald ich eine Zelle verlasse? In diesem Fall würde
ich gerne nach dem Verlassen der Zellen, in die die Zahlenkolonnen stehen,
das 'Extrahiermakro' laufen lassen.
Gruß
Horst

Hallo Horst,

Ich glaube nicht ,dass Du bei Deinem Vorhaben ohne Makro auskommen
wirst.

Das Verlassen einer Zelle jedoch ist mir kein bekanntes "event", um
u.a. ein Makro auszulösen.

Was dem am nächsten kommt, ist vielleicht anstelle das WorkSheet Event
"BeforeRightClick" oder auch noch "BeforeDoubleClick" zu wählen,
wobei Du die Operationen mit einem Rechts- oder einem Doppelklick
auslösen kannst, Das WorkBook Event "BeforeSave" könnte ja auch
noch Sinn machen.

L.G.

Jean

[Jean Ruch]

"Horst Köhler" <***@discussions.microsoft.com> schrieb im
Newsbeitrag news:6E25FE45-207E-4C3B-B2B9-***@microsoft.com...
Hallo Horst,

mit etwas rumprobieren komme ich zu folgender Möglichkeit.
Bei folgendem Code:

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub

If Not Target Is Nothing Then Target.TextToColumns _
Destination:=Target, Space:=True

End Sub

komme ich Deinem Wunsch auch ziemlich nahe:

Gib mal per Hand irgendwo in Spalte B abc def ghi jkl
sei Dreierpakete Buchstaben getrennt durch ein Leerzeichen.
Bei der Eingabe passiert nichts
wenn Du die Zelle aber verläßt, (Dein Wunsch)
wird der String in Spalten getrennt

wenn ich Deinen String 14 19 3 7025 22 14458 38 kopiere
und in eine Zelle der Spalte B einfüge, wird er sofort in
Spalten auseinander gepflückt.
Braucht man dann nur noch kopiern, transponieren, sortieren und
an gewünschter Stelle einfügen.

mit freundlichem Gruß

Jean

[Horst Köhler]

Hallo Jean

Post by Jean Ruch
mit etwas rumprobieren komme ich zu folgender Möglichkeit.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub
If Not Target Is Nothing Then Target.TextToColumns _
Destination:=Target, Space:=True
End Sub
Gib mal per Hand irgendwo in Spalte B abc def ghi jkl
sei Dreierpakete Buchstaben getrennt durch ein Leerzeichen.
Bei der Eingabe passiert nichts
wenn Du die Zelle aber verläßt, (Dein Wunsch)
wird der String in Spalten getrennt
wenn ich Deinen String 14 19 3 7025 22 14458 38 kopiere
und in eine Zelle der Spalte B einfüge, wird er sofort in
Spalten auseinander gepflückt.

Das sieht schon sehr gut aus. Das einzige, was noch stört, ist die Tatsache,
dass die Zahlenkolonne gelöscht wird (wär schön, wenn die drin bliebe), und
die erste Zahl der Kolonne in der Eingabezelle stehen bleibt.

Post by Jean Ruch
Braucht man dann nur noch kopiern, transponieren, sortieren und
an gewünschter Stelle einfügen.

Das nur hört sich einfach an (vor allem, weil du 'nur' schreibst), bin
gespannt, obs das dann auch ist ;)

Gruß

Horst

[Jean Ruch]

Post by Horst Köhler
Hallo Jean
Das sieht schon sehr gut aus. Das einzige, was noch stört, ist die Tatsache,
dass die Zahlenkolonne gelöscht wird (wär schön, wenn die drin bliebe), und
die erste Zahl der Kolonne in der Eingabezelle stehen bleibt.

Post by Jean Ruch
Braucht man dann nur noch kopiern, transponieren, sortieren und
an gewünschter Stelle einfügen.

Das nur hört sich einfach an (vor allem, weil du 'nur' schreibst), bin
gespannt, obs das dann auch ist ;)

Hallo Horst,
wenn es nur darum geht, ein bischen ergänzter Code in diesem Sinne:
Am besten in Tabelle 1 einer neuen Datei ausprobieren,
den zu bearbeitenden String irgendwo in Spalte B:B einfügen.
Das sortierte Ergebnis ist dann ab B2 abwärts in Blattes 2 .
Der Originalwert bleibt auch bestehen.

Aber trotzdem...
ich bin kein so großer Freund für EreignisEvents, wenn sie nicht
unbedingt nötig sind.
mal sehen, ob ich nicht besser ohne auskomme, besonders wenn es um
"nur" der Aufgabestellung, wie im original Posting beschrieben.
Manchmal kommen unerwünschte Erscheinungen zu Tage ;-)

Und hier die kleine Ergänzung

mit freundlichem Gruß

Jean


Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub

If Not Target Is Nothing Then Target.TextToColumns _
Destination:=Target.Offset(0, 1), Space:=True

Target.Offset(0, 1).Select

Range(Selection, Selection.End(xlToRight)).Copy

ActiveWorkbook.Sheets("Tabelle2").Cells(2, 2).PasteSpecial _
Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=True

ActiveWorkbook.Sheets("Tabelle2").Activate
ActiveWorkbook.Sheets("Tabelle2").Cells(2, 2).Select
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select

Selection.Sort _
Key1:=Worksheets("Tabelle2").Range("B2"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers

End Sub

[Jean Ruch]

Post by Horst Köhler
Hallo Jean
mal sehen, ob ich nicht besser ohne (Event-Makro) auskomme, besonders
wenn es um
"nur" der Aufgabenstellung geht, wie im original Posting beschrieben.

.
In einer (neuen) Datei gib die 6 Strings in die Zellen A1 bis A6
und lasse mal diesen Code ablaufen :

Sub Tabellen_Umbau_ohne_Ereignis_Event()

For i = 1 To 6
j = i + 1
Sheets("Tabelle1").Cells(i, 1).Copy
Destination:=Sheets("Tabelle1").Cells(i, 2)
Sheets("Tabelle1").Cells(i, 3).Select
With Selection
.Value = Cells(i, 2).Value
.TextToColumns Destination:=ActiveCell, Space:=True
End With
Range(Selection, Selection.End(xlToRight)).Copy
ActiveWorkbook.Sheets("Tabelle2").Cells(2, j).PasteSpecial _
Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=True
ActiveWorkbook.Sheets("Tabelle2").Activate
ActiveWorkbook.Sheets("Tabelle2").Cells(2, j).Select
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
Selection.Sort _
Key1:=Worksheets("Tabelle2").Cells(2, j), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers
Sheets("Tabelle1").Select
Next
End Sub

Bei mir läuft er bestens und ist auch einfacher (meiner Meinung nach)

mit freundlichem Gruß

Jean

[Horst Köhler]

Hallo Jean

Post by Jean Ruch
For i = 1 To 6
j = i + 1
Sheets("Tabelle1").Cells(i, 1).Copy
Destination:=Sheets("Tabelle1").Cells(i, 2)
Sheets("Tabelle1").Cells(i, 3).Select
With Selection
.Value = Cells(i, 2).Value
.TextToColumns Destination:=ActiveCell, Space:=True
End With
Range(Selection, Selection.End(xlToRight)).Copy
ActiveWorkbook.Sheets("Tabelle2").Cells(2, j).PasteSpecial _
Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=True
ActiveWorkbook.Sheets("Tabelle2").Activate
ActiveWorkbook.Sheets("Tabelle2").Cells(2, j).Select
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
Selection.Sort _
Key1:=Worksheets("Tabelle2").Cells(2, j), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers
Sheets("Tabelle1").Select
Next
End Sub
Bei mir läuft er bestens und ist auch einfacher (meiner Meinung nach)
mit freundlichem Gruß
Jean

Das Funktionierte auch fast fehlerfrei, nur wenn eine der Zellen leer war,
gabs eine Fehlermeldung, und die Bestätigungsabfrage, ob die Zellen
überschrieben werden sollen, war auch lästig :)

Ich hab das so 'umgestrickt' (und Tabelle2 gleich noch ausgeblendet, da ich
die Daten dann noch in eine Spalte sortiere, und mit nem Sverweis daruf
zugreife):

Sub Navirouten_auflösen()
Sheets("Tabelle1").Select
Columns("D:IV").Select
Selection.EntireColumn.Hidden = False
Range("D3:IV22").Select
Selection.ClearContents
Sheets("Tabelle2").Visible = True
Sheets("Tabelle2").Select
Range("G1:Z100").Select
Selection.ClearContents
Sheets("Tabelle1").Select
i = 3
While Sheets("Tabelle1").Cells(i, 3) <> ""
j = i + 4
Sheets("Tabelle1").Cells(i, 3).Copy
Destination:=Sheets("Routen").Cells(i, 4)
Sheets("Tabelle1").Cells(i, 4).Select
With Selection
.Value = Cells(i, 3).Value
.TextToColumns Destination:=ActiveCell, Space:=True
End With
Range(Selection, Selection.End(xlToRight)).Copy
ActiveWorkbook.Sheets("Tabelle2").Cells(1, j).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=True
ActiveWorkbook.Sheets("Tabelle2").Activate
ActiveWorkbook.Sheets("Tabelle2").Cells(1, j).Select
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
Selection.Sort _
Key1:=Worksheets("Tabelle2").Cells(1, j), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers
Sheets("Tabelle1").Select
i = i + 1
Wend
Sheets("Tabelle2").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Tabelle1").Select
Columns("D:IV").Select
Selection.EntireColumn.Hidden = True
Range("C3").Select
End Sub


Für deine Mühen eine herzliches Danke

Gruß

Horst

[Jean Ruch]

Post by Horst Köhler
Hallo Jean

Post by Jean Ruch
For i = 1 To 6
j = i + 1
Sheets("Tabelle1").Cells(i, 1).Copy
Destination:=Sheets("Tabelle1").Cells(i, 2)
Sheets("Tabelle1").Cells(i, 3).Select
With Selection
.Value = Cells(i, 2).Value
.TextToColumns Destination:=ActiveCell, Space:=True
End With
Range(Selection, Selection.End(xlToRight)).Copy
ActiveWorkbook.Sheets("Tabelle2").Cells(2, j).PasteSpecial _
Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=True
ActiveWorkbook.Sheets("Tabelle2").Activate
ActiveWorkbook.Sheets("Tabelle2").Cells(2, j).Select
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
Selection.Sort _
Key1:=Worksheets("Tabelle2").Cells(2, j), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers
Sheets("Tabelle1").Select
Next
End Sub
Bei mir läuft er bestens und ist auch einfacher (meiner Meinung nach)
mit freundlichem Gruß
Jean

Das Funktionierte auch fast fehlerfrei, nur wenn eine der Zellen leer war,
gabs eine Fehlermeldung, und die Bestätigungsabfrage, ob die Zellen
überschrieben werden sollen, war auch lästig :)
Ich hab das so 'umgestrickt' (und Tabelle2 gleich noch ausgeblendet, da ich
die Daten dann noch in eine Spalte sortiere, und mit nem Sverweis daruf
Sub Navirouten_auflösen()
Sheets("Tabelle1").Select
Columns("D:IV").Select
Selection.EntireColumn.Hidden = False
Range("D3:IV22").Select
Selection.ClearContents
Sheets("Tabelle2").Visible = True
Sheets("Tabelle2").Select
Range("G1:Z100").Select
Selection.ClearContents
Sheets("Tabelle1").Select
i = 3
While Sheets("Tabelle1").Cells(i, 3) <> ""
j = i + 4
Sheets("Tabelle1").Cells(i, 3).Copy
Destination:=Sheets("Routen").Cells(i, 4)
Sheets("Tabelle1").Cells(i, 4).Select
With Selection
.Value = Cells(i, 3).Value
.TextToColumns Destination:=ActiveCell, Space:=True
End With
Range(Selection, Selection.End(xlToRight)).Copy
ActiveWorkbook.Sheets("Tabelle2").Cells(1, j).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=True
ActiveWorkbook.Sheets("Tabelle2").Activate
ActiveWorkbook.Sheets("Tabelle2").Cells(1, j).Select
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
Selection.Sort _
Key1:=Worksheets("Tabelle2").Cells(1, j), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers
Sheets("Tabelle1").Select
i = i + 1
Wend
Sheets("Tabelle2").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Tabelle1").Select
Columns("D:IV").Select
Selection.EntireColumn.Hidden = True
Range("C3").Select
End Sub
Für deine Mühen eine herzliches Danke

Hallo Horst,

es freut mich, wenn ich Dir ein paar Denkanstöße geben konnte,
die zum Erfolg führten.
Vielleicht kann man jetzt noch ein paar "Select" rauskürzen,
aber die Hauptsache ist doch, dass es läuft ;-)
mit freundlichem Gruß

Jean