VBA Hilfe beim Sortieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Henrik,
das geht wohl nur per Makro.
Du bist in Excel, drücke Alt+F11, damit wechselst du in den VBA-Editor.
Jetzt gehst du auf "Einfügen" , dann "Modul" und kopierst den Code in das rechte Fenster.
Schließe den VBA-Editor (Schließen-Kreuz rechts oben), gehe auf das Tabellenblatt mit deiner Liste, drücke Alt+F8, wähle das Makro in der Liste aus und klicke auf "Ausführen".

Public Sub SortCopy()
Dim WkSh_Q       As Worksheet
Dim WkSh_Z       As Worksheet
Dim lZeile       As Long
Dim lLetzte      As Long
Dim iSpalte      As Integer
Dim sVorheriger  As String
   Set WkSh_Q = Worksheets("Tabelle1")
   Set WkSh_Z = Worksheets("Tabelle2")

   lLetzte = WkSh_Q.Range("A65536").End(xlUp).Row
   If lLetzte < 9 Then lLetzte = 9

   WkSh_Q.Range("A9:A" & lLetzte).Sort _
          Key1:=Range("A9"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

   If lLetzte < 256 Then
      iSpalte = 1
    Else
      MsgBox "es sollen zu viele Werte in EINE Zeile eingefügt werden - Abbruch.", _
         16, "   Hinweis für " & Application.UserName
      Exit Sub
   End If

   For lZeile = 9 To lLetzte
      If WkSh_Q.Range("A" & lZeile).Value <> sVorheriger Then
         WkSh_Q.Range("A" & lZeile).Copy Destination:=WkSh_Z.Cells(2, iSpalte)
         iSpalte = iSpalte + 1
         sVorheriger = WkSh_Q.Range("A" & lZeile).Value
      End If
   Next lZeile
Viele Grüße Peter
Eine kurze Nachricht, ob es läuft, wäre nett - danke.

Hallo Henrik,
dass die Sortier-Reihenfolge nicht verändert werden darf, hattest du leider verschwiegen.
Hier ein Lösung, die kein neues Blatt erfordert, sondern kurzzeitig nur eine neue Spalte, die am Ende wieder gelöscht wird.
Versuch es mal:

'
'   In (Tabellenblatt "1") stehen in (Spalte "A") folgende Werte:
'   A2=-1,0 / A3=-1,5 / A4=-2,0 / A5=-0,5 / A6=1,5 / A7=0,5 / A8=0,0 /usw.
'
'   Gesucht wird ein Makro, das diese Werte in (Tabellenblatt "2")
'   in (Zeile"2") sortiert einfügt.
'
'   Folgende Bedingungen sollen gelten:
'
'   1. Einfügen: Beginnen bei der kleinsten Zahl
'      (also: Blatt2 Zelle A2=-2,0 / B2=-1,5 /C2=-0,5 /usw.)
'   2. Doppelt vorkommende Werte nur einmal aufführen
'   3. Makro soll auf Blatt1 in Spalte A ,Zeile9 anfangen und aufhören,
'      wenn die erste freie Zelle in Spalte A kommt.
'
Public Sub SortCopy()
Dim WkSh_Q       As Worksheet
Dim WkSh_Z       As Worksheet
Dim lZeile       As Long
Dim lLetzte      As Long
Dim iSpalte      As Integer
Dim sVorheriger  As String
   Application.ScreenUpdating = False

   Set WkSh_Q = Worksheets("Tabelle1")
   Set WkSh_Z = Worksheets("Tabelle2")

   lLetzte = WkSh_Q.Range("A65536").End(xlUp).Row
   If lLetzte < 9 Then lLetzte = 9

   WkSh_Q.Columns("A:A").Insert Shift:=xlToRight
   WkSh_Q.Range("B9:B" & lLetzte).Copy Destination:=WkSh_Q.Range("A9:A" & lLetzte)

   Worksheets("Tabelle1").Activate

   WkSh_Q.Range("A9:A" & lLetzte).Sort _
          Key1:=Range("A9"), Order1:=xlAscending, Header:=xlGuess, _
          OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

   If lLetzte < 257 Then
      iSpalte = 1
    Else
      MsgBox "es sollen zu viele Werte in EINE Zeile eingefügt werden - Abbruch.", _
         16, "   Hinweis für " & Application.UserName
      Exit Sub
   End If

   For lZeile = 9 To lLetzte
      If Not IsEmpty(WkSh_Q.Range("A" & lZeile).Value) Then
         If WkSh_Q.Range("A" & lZeile).Value <> sVorheriger Then
            WkSh_Q.Range("A" & lZeile).Copy Destination:=WkSh_Z.Cells(2, iSpalte)
            iSpalte = iSpalte + 1
            sVorheriger = WkSh_Q.Range("A" & lZeile).Value
         End If
      End If
   Next lZeile

   WkSh_Q.Columns("A:A").Delete Shift:=xlToLeft
   Application.CutCopyMode = False
   Application.ScreenUpdating = True

End Sub
Viele Grüße Peter
Eine kurze Nachricht, ob es läuft, wäre nett - danke.

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread