Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1264to1268
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

Werte in einer einzelnen Zelle sortieren

Werte in einer einzelnen Zelle sortieren
Marc
Hallo liebes Forum,
ich habe eine bestimmte Zelle (Blatt2, H115), in der sich ausschließlich Text mit variablem Inhalt befindet.
Die einzelnen Begriffe dort sind immer durch ein Komma und ein Leerfeld voneinander getrennt, andere Satz- oder Sonderzeichen werden nicht verwendet.

Zum Beispiel steht dort:

Emil, Anton, Gustav, Franz, Berta
Gibt es eine Möglichkeit, nur die Werte in dieser einen Zelle per VBA alphabetisch zu sortieren ?
Am Ende sollte das obige Beispiel dann so aussehen:
Anton, Berta, Emil, Franz, Gustav
VG und vielen Dank im Voraus für jeden Tipp !
Marc
AW: Werte in einer einzelnen Zelle sortieren
19.06.2012 12:06:35
bst
Hi,
google mal nach VBA Quicksort und/oder VBA Bubblesort. Damit nimm einfach so etwas:
Sub x()
Dim arData
With Worksheets("Blatt2").Range("H115")
arData = Split(.Value, ", ")
BubbleSort arData
.Value = Join(arData, ", ")
End With
End Sub
cu, Bernd
AW: Werte in einer einzelnen Zelle sortieren
19.06.2012 12:30:43
Marc
Hallo Bernd,
vielen Dank für Deine Antwort !
QuickSort hatte ich schon probiert (mit dem unten stehenden Code).
Was mich gestört hat ist, dass der Code hier relativ lange rechnet obwohl es nur eine Zelle betrifft.
Kann man hier evtl. etwas kürzen, um den Code schneller zu machen und nicht benötigte Rechenschritte zu vermeiden ?
Sub Macro1()
Dim rngC As Range, arrTmp, x
For Each rngC In Worksheets(2).Range("H115").SpecialCells(xlCellTypeConstants)
arrTmp = Split(rngC, ",")
For x = 0 To UBound(arrTmp)
arrTmp(x) = Trim(arrTmp(x))
Next
QuickSortHol arrTmp
rngC = Join(arrTmp, ", ")
Next
End Sub

Sub QuickSortHol(ByRef DasArray, Optional ErsteZeile, Optional LetzteZeile)
On Error Resume Next
Dim UnterGrenze As Long, OberGrenze As Long
Dim AktuellerWert, GemerkterWert As Variant, tmpWert As Variant
Dim tmpArray, i
tmpArray = DasArray
For i = LBound(DasArray) To UBound(DasArray)
DasArray(i) = UCase(DasArray(i))
Next
If IsMissing(ErsteZeile) Then
ErsteZeile = LBound(DasArray, 1)
End If
If IsMissing(LetzteZeile) Then
LetzteZeile = UBound(DasArray, 1)
End If
UnterGrenze = ErsteZeile
OberGrenze = LetzteZeile
AktuellerWert = DasArray((ErsteZeile + LetzteZeile) / 2)
Do While (UnterGrenze  AktuellerWert And OberGrenze > ErsteZeile)
OberGrenze = OberGrenze - 1
Loop
If (UnterGrenze  ErsteZeile) Then Call QuickSortHol(DasArray, ErsteZeile, OberGrenze)
If (UnterGrenze 
VG,
Marc
Anzeige
AW: Werte in einer einzelnen Zelle sortieren
19.06.2012 12:36:19
Reinhard
Hallo Marc,
nur eine Zelle?
Teste mal dieses:
Sub Macro1()
Dim rngC As Range, arrTmp, x
MsgBox Worksheets(2).Range("H115").SpecialCells(xlCellTypeConstants).Address
MsgBox Worksheets(2).Range("H115").SpecialCells(xlCellTypeConstants).Cells.Count
For Each rngC In Worksheets(2).Range("H115").SpecialCells(xlCellTypeConstants)
arrTmp = Split(rngC, ",")
For x = 0 To UBound(arrTmp)
arrTmp(x) = Trim(arrTmp(x))
Next
QuickSortHol arrTmp
rngC = Join(arrTmp, ", ")
Next
End Sub

Gruß
Reinhard
AW: Werte in einer einzelnen Zelle sortieren
19.06.2012 12:45:11
Marc
Hallo Reinhard,
vielen Dank !
Das funktioniert leider gar nicht - statt dessen erhalte ich zwei Message Boxen, die erste mit einer Reihe von Werten, die zweite mit einer Zahl ?
VG,
Marc
Anzeige
AW: Werte in einer einzelnen Zelle sortieren
19.06.2012 12:56:03
Reinhard
Hallo Marc,
genau das sollen die zwei Codezeilen tuen.
Du sprichst von einer Zelle, die erste MsgBox zeigt dir die Zelladressen deiner einen Zelle.
Die zweite MB die Anzahl der Zellen.
Probiere mal den nachfolgenden Code.
Gruß
Reinhard
Sub tt()
Dim wks As Worksheet, Spa As Long, Zei As Long
Set wks = Worksheets("Tabelle2")
Worksheets.Add after:=Worksheets(Worksheets.Count)
With ActiveSheet
wks.Range("H115").Copy .Range("A1")
.Range("A1").Value = .Range("A1").Value & ","
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1))
Spa = .Cells(1, Columns.Count).End(xlToLeft).Column
.Range(.Cells(1, 1), .Cells(1, Spa)).Copy
.Range("A2").PasteSpecial Paste:=xlAll, Transpose:=True
.Rows(1).Delete
.Range(Cells(1, 1), Cells(Spa, 1)).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo,  _
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
wks.Range("H115").ClearContents
For Zei = 1 To Spa - 1
wks.Range("H115").Value = wks.Range("H115").Value & .Range("A" & Zei).Value & " "
Next Zei
wks.Range("H115").Value = wks.Range("H115").Value & Replace(.Range("A" & Zei).Value, _
",", "")
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
wks.Activate
End With
End Sub

Anzeige
AW: Werte in einer einzelnen Zelle sortieren
19.06.2012 15:17:30
Marc
Hallo Reinhard,
vielen vielen Dank dafür - das klappt perfekt und ist super-schnell !
Noch eine (Anfänger-)Frage dazu:
In Deinem Code taucht an manchen Stellen A1 bzw. A2 auf.
Heißt das, hier wird temporär etwas in diese (oder in andere Zellen) geschrieben, für das ich evtl. eine andere, freie Zelle angeben müsste ?
VG und nochmals danke,
Marc
AW: Werte in einer einzelnen Zelle sortieren
19.06.2012 19:29:45
Marc
Hallo Reinhard,
das hat sich erledigt - ich habe es mit meinem vorherigen Code hinbekommen.
VG und trotzdem danke,
Marc
OT@Reinaldo zu Direktansprache
19.06.2012 13:29:31
Luc:-?
Hallo Reinhard,
zu deiner letzte Nacht im Archiv gelandeten Anfrage vom 12.06. will ich Folgendes bemerken:
1. So, wie du das ursprgl versucht hast, geht's wirklich nicht. Das Warum hat dir Erich erläutert.
2. Dahingegen hat Rudi das auf einen falschen „Punkt gebracht“! Es geht schon, wenn man es denn richtig macht.
a) In der der Mappe, in der der PgmCode steht, geht es genau für diese Mappe immer, wenn man nur den Internnamen des Blattes verwendet.
b) Blätter anderer Mappen können nicht oW angesprochen wdn, was den Grund hat, dass deren Internnamen in der Standortmappe des Pgms unbekannt sind. Sie wdn erst dadurch bekannt, dass du einen Verweis auf diese andere(n) Mappe(n) setzt, wobei es äußerst hilfreich ist, wenn nicht alles die Standard-Internnamen hat, denn sie können auch individuell festgelegt, also geändert* wdn. Also zB vbPAMap1 bzw …2 statt VBAProject, AMap1 bzw …2 statt DieseArbeitsmappe u/o Tab1 statt Tabelle1, wobei auch folgende TabellenNummerung Sinn macht: in AMap1Tab1_1, Tab1_2 usf, in AMap2Tab2_1, Tab2_2 usf.
c) Wurden über alle betroffenen Mappen unterschiedl InternBlattnamen nach letztgenanntem Muster vergeben, kann jedes Blatt jeder Mappe direkt aus dem Pgm einer anderen Mappe, deren vbProjekt einen Verweis auf diese Mappen enthält, angesprochen wdn. Ist das nicht der Fall, sondern die StandardInternNamen wurden beibehalten, fktt das so nicht, weil natürlich die eigenen Namen der PgmStdortMappe priorisiert wdn. In diesem Fall kann man sich mit einem kleinen Pgm in der jeweiligen Mappe behelfen, dem ein Parameter übergeben wdn kann, der dann direkt eingetragen wird. Durch den Verweis auf diese Mappe in der Trägermappe des HptPgms ist diesem der Name dieser Subroutine bekannt und sie kann, mit dem einzutragenden Wert parametriert, aufgerufen wdn.
*Scheint weitgehend unbekannt zu sein!
Gruß Luc :-?
Anzeige
AW: OT@Reinaldo zu Direktansprache
19.06.2012 21:05:35
Reinhard
Hallo Luc,
Reinaldo? Ah, ich weiß, wegen meinem Aussehen verwechselst du mich Freudmäßig mit Ronaldo :-))
Soy reinardo.
Zum Thema, dankeschön fürs Nachbohren.
Gruß
Reinhard
Der irrtüml Umkehr-Rhotazismus war mir ...
20.06.2012 01:09:02
Luc:-?
…inzwischen auch schon aufgefallen, Reinhard alias Reinardo;
der Andere hieß wohl Rinaldo (Rinaldini)… ;-)
AW: Werte in einer einzelnen Zelle sortieren
19.06.2012 13:30:28
bst
Hi,
Kann man hier evtl. etwas kürzen, um den Code schneller zu machen und nicht benötigte Rechenschritte zu vermeiden ?
Wirf das tmpArray und den UCase-Teil aus Quicksort raus, das brauchst Du nicht.
Benutze besser Option Compare Text.
Und, M.E. sollte das nicht lange dauern. Es sei denn das Zurückschreiben der Wertes in die Zelle löst 'unzählige' Formel-Neuberechnungen und/oder Change-Events aus.
cu, Bernd
Anzeige
AW: Werte in einer einzelnen Zelle sortieren
19.06.2012 14:07:10
Marc
Hallo Bernd,
vielen Dank dafür - das klingt gut !
Kannst Du mir genau sagen, wie der Code dann am Ende aussehen soll ?
Ich bin mit VBA noch recht am Anfang und möchte hier nicht an den falschen Stellen Änderungen vornehmen.
VG und nochmals danke,
Marc
AW: Werte in einer einzelnen Zelle sortieren
20.06.2012 08:34:09
bst
Morgen,
mache das mal so.
cu, Bernd
--
Option Explicit
Option Compare Text

Sub Macro1()
    Dim arrTmp, x As Long
    With Range("H115")
        arrTmp = Split(.Value, ",")
        For x = 0 To UBound(arrTmp)
            arrTmp(x) = Trim(arrTmp(x))
        Next
        QuickSort arrTmp
        .Value = Join(arrTmp, ", ")
    End With
End Sub

Sub QuickSort(ByRef DasArray, Optional ErsteZeile = -1, Optional LetzteZeile = -1)
    Dim UnterGrenze As Long, OberGrenze As Long
    Dim AktuellerWert, GemerkterWert As Variant, tmpWert As Variant
    
    If ErsteZeile < 0 Then ErsteZeile = LBound(DasArray)
    If LetzteZeile < 0 Then LetzteZeile = UBound(DasArray)
    
    UnterGrenze = ErsteZeile
    OberGrenze = LetzteZeile
    AktuellerWert = DasArray((ErsteZeile + LetzteZeile) \ 2)
    
    Do While (UnterGrenze <= OberGrenze)
        Do While (DasArray(UnterGrenze) < AktuellerWert And UnterGrenze < LetzteZeile)
            UnterGrenze = UnterGrenze + 1
        Loop
        Do While (DasArray(OberGrenze) > AktuellerWert And OberGrenze > ErsteZeile)
            OberGrenze = OberGrenze - 1
        Loop
        
        If (UnterGrenze <= OberGrenze) Then
            GemerkterWert = DasArray(UnterGrenze)
            DasArray(UnterGrenze) = DasArray(OberGrenze)
            DasArray(OberGrenze) = GemerkterWert
            UnterGrenze = UnterGrenze + 1
            OberGrenze = OberGrenze - 1
        End If
    Loop
    
    If (OberGrenze > ErsteZeile) Then Call QuickSort(DasArray, ErsteZeile, OberGrenze)
    If (UnterGrenze < LetzteZeile) Then Call QuickSort(DasArray, UnterGrenze, LetzteZeile)
End Sub


Anzeige

362 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige