Live-Forum - Die aktuellen Beiträge
Datum
Titel
23.04.2024 14:59:21
23.04.2024 14:47:39
23.04.2024 14:23:45
Anzeige
Archiv - Navigation
680to684
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
680to684
680to684
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Sortieren für Cracks

Sortieren für Cracks
17.10.2005 12:07:45
Elmar
Hallo Zusammen,
ich habe eine Frage zur komplexen Sortierung in Excel.
Auf Grund einer etwas "mangelbehafteten" Verarbeitungslogik eines Importbausteins muss ich Excel Daten in einer bestimmten Sortierung anliefern.
Konkret geht es darum eine Liste von mehreren tausend Einträgen so zu sortieren, daß die ID einer Zeile (die ID´s können mehrmals vorkommen) auf keinen Fall hintereinander folgen.
Also nie:
4711
4711
0815
0815
sondern
4711
0815
4711
Wie drückt man sowas in Excel bei einer Sortierung aus?
Vielen Dank für die Infos!
Elmar

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Sortieren für Cracks
17.10.2005 13:08:32
MichaV
Hallo,
spielt die Sortierreihenfolge eine Rolle (und wenn ja, nach welchen Kriterien soll umsortiert werden) oder ist nur wichtig, daß keine doppelten Einträge hintereinander stehen?
Gruss- Micha
AW: Sortieren für Cracks
17.10.2005 13:43:19
Elmar
In diesem konkreten Fall spielt die weitere Sortierung keine Rolex.
Allerdings wäre es natürlich sehr interessant zu sehen, wie ich eine weitere Untersortierebene enschieben kann.
Solltest du also ein sprechendes Beispiel kennen und dir kein Aufwand entstehen, dann kannst du das gerne ebenfalls posten.
Schöne Grüße,
Elmar
AW: Sortieren für Cracks
17.10.2005 14:00:24
MichaV
Hallo,
nix aus der Schublade, in der Mittagspause gebastelt. Geht sicher noch optimaler, aber funzt soweit. Wenn die Wahrscheinlichkeit besteht, daß das Trennen von Gleichen mal nicht möglich ist (z.B: a,a,a,a,b), dann gib eine kurze Info, sonst hängt sich der Code auf.


Option Explicit
Sub GleicheTrennen()
Dim e As Long
Dim i As Long
Dim rngStart As Range
Dim t
Dim bTausche As Boolean
Dim bGetauscht As Boolean
Set rngStart = Cells(1, 1) 'oder =Activecell , jedenfalls Deine Start- Zelle
e = rngStart.End(xlDown).Row 'bis zur ersten Leerzeile
Gruss- Micha
PS: Rückmeldung wäre nett.
Anzeige
AW: Sortieren für Cracks
17.10.2005 17:03:45
Elmar
Erstmal einen herzlichen Dank für deinen VB-Code.
Ich bin in ziemlich vielen Sprachen fit aber VB gehört leider nicht dazu.
Der Code funktioniert leider bei meinem Beispiel nicht so optimal.
Aus diesen Zahlen:
10004700
10005300
10005300
10007300
10007301
10007301-0015A
10007301-0015A
10007305
10007305
macht er folgendes:
10004700
10005300
10005300
10007300
10007301-0015A
10007301
10007301-0015A
10007305
10007305
Ich möchte Dir aber wirklich keinen Aufwand damit machen. Inzwischen haben wir das Problem erstmal mit der Krücke über Access gelöst. Mich hat halt einfach nur brennend interessiert, wie man das mit Excel-Bordmitteln vernünftig lösen könnte.
Danke nochmal!
Elmar
Anzeige
AW: Sortieren für Cracks
17.10.2005 19:40:49
MichaV
Hallo,
das ist wahrlich nicht befriedigend. Du hast sicher nicht in A1 angefangen und das hatte ich falsch aufgeschrieben.
So funzt es. Du musst den Bereich vorher markieren oder passe den oberen Teil nach Deinen Bedürfnissen an:


      
Option Explicit
Sub GleicheTrennen()
Dim e As Long
Dim a As Long
Dim s As Long
Dim i As Long
Dim t
Dim bTausche As Boolean
Dim bGetauscht As Boolean
a = Selection.Cells(1).Row 
'erste Zeile, ggf. anpassen
e = Selection.Cells(Selection.Cells.Count).Row  'letzte Zeile, ggf. anpassen
s = Selection.Column 'Spalte, ggf. anpassen

Do
  bGetauscht = 
False
  
For i = e To a Step -1
  
' von unten nach oben
  ' x
  ' a
  ' a
  ' a
  ' b
  'wird zu
  ' a
  ' x
  ' a
  ' a
  ' b
    If Cells(i, s) = Cells(i - 1, s) Then
      bTausche = 
True
    
ElseIf bTausche Then
      t = Cells(i, s)
      Cells(i, s) = Cells(i - 1, s)
      Cells(i - 1, s) = t
      bTausche = 
False
      bGetauscht = 
True
    
End If
  
Next i
  
For i = a To e - 1
  
' von oben nach unten
  ' a
  ' x
  ' a
  ' a
  ' b
  'wird zu
  ' a
  ' x
  ' a
  ' b
  ' a
    If Cells(i, s) = Cells(i + 1, s) Then
      bTausche = 
True
    
ElseIf bTausche Then
      t = Cells(i, s)
      Cells(i, s) = Cells(i + 1, s)
      Cells(i + 1, s) = t
      bTausche = 
False
      bGetauscht = 
True
    
End If
  
Next i
Loop Until Not bGetauscht
'Schleife so lange durchlaufen, bis nichts meht getauscht wurde
'Das kann zu Endlosschleifen führen, wenn das Trennen von Gleichen
'aufgrund deren Anzahl nicht möglich ist!
Set rngStart = Nothing
End Sub 
PS: Rückmeldung wäre nett.
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige