Microsoft Excel

Herbers Excel/VBA-Archiv

Liste automatisch neu erstellen und umsortieren

Betrifft: Liste automatisch neu erstellen und umsortieren von: Markus
Geschrieben am: 25.07.2008 21:57:53

Hallo liebe Forumsteilnehmer,

ich benötige eure Hilfe bei folgendem Problem, welches ich gerne mit Excel lösen würde.

Ich habe eine Liste mit folgende Spalten und folgenden Beispieleinträgen

Lfd. Nr. Name1 Name2 Name3 Bemerkung Ablageort
001 A B C Larum Leitz
002 Z W X Lirum Leitz
003 usw.
004 usw.

Die Liste wird ständig erweitert. Nun zum Problem: Über ein Makro hätte ich gerne eine zweite Tabelle
automatisch geöffnet die auf der Grundlage der vorgenannten Daten folgendes erzeugt:

Lfd. Nr. Name1 Name2 Name3 Bemerkung Ablageort
001 A B C Larum Leitz
001 B A C Larum Leitz
001 C A B Larum Leitz
002 W X Z Lirum Leitz
002 X W Z Lirum Leitz
002 Z X W Lirum Leitz

Also aus den Spalten Name1, Name2 und Name3 soll jeweils jeder Eintrag einmal alphabetisch sortiert unter Name1 erscheinen und daneben dann Name2 und Name 3, sowie unverändert Bemerkung und Ablageort.

Hat vielleicht jemand eine Lösunsgidee?

Beste Grüße

Markus

  

Betrifft: AW: Liste automatisch neu erstellen und umsortiere von: ChrisL
Geschrieben am: 26.07.2008 09:46:32

Hallo Markus

Probier mal...

Sub Makro1()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim i As Long, LetzteZeile1 As Long, LetzteZeile2 As Long

Set WS1 = Worksheets("Tabelle1")
Set WS2 = Worksheets("Tabelle2")

WS2.Rows("2:65536").Delete
LetzteZeile1 = WS1.Range("A65536").End(xlUp).Row

For i = 2 To LetzteZeile1
    LetzteZeile2 = WS2.Range("A65536").End(xlUp).Row + 1
    
    WS2.Cells(LetzteZeile2, 1) = WS1.Cells(i, 1)
    WS2.Cells(LetzteZeile2 + 1, 1) = WS1.Cells(i, 1)
    WS2.Cells(LetzteZeile2 + 2, 1) = WS1.Cells(i, 1)
    
    WS2.Cells(LetzteZeile2, 2) = WS1.Cells(i, 2)
    WS2.Cells(LetzteZeile2 + 1, 2) = WS1.Cells(i, 3)
    WS2.Cells(LetzteZeile2 + 2, 2) = WS1.Cells(i, 4)
    
    WS2.Cells(LetzteZeile2, 3) = WS1.Cells(i, 3)
    WS2.Cells(LetzteZeile2 + 1, 3) = WS1.Cells(i, 2)
    WS2.Cells(LetzteZeile2 + 2, 3) = WS1.Cells(i, 2)
    
    WS2.Cells(LetzteZeile2, 4) = WS1.Cells(i, 4)
    WS2.Cells(LetzteZeile2 + 1, 4) = WS1.Cells(i, 4)
    WS2.Cells(LetzteZeile2 + 2, 4) = WS1.Cells(i, 3)
    
    WS2.Cells(LetzteZeile2, 5) = WS1.Cells(i, 5)
    WS2.Cells(LetzteZeile2 + 1, 5) = WS1.Cells(i, 5)
    WS2.Cells(LetzteZeile2 + 2, 5) = WS1.Cells(i, 5)
    
    WS2.Cells(LetzteZeile2, 6) = WS1.Cells(i, 6)
    WS2.Cells(LetzteZeile2 + 1, 6) = WS1.Cells(i, 6)
    WS2.Cells(LetzteZeile2 + 2, 6) = WS1.Cells(i, 6)
    
Next i
End Sub



Gruss
chris


  

Betrifft: AW: Liste automatisch neu erstellen und umsortiere von: Markus
Geschrieben am: 26.07.2008 13:16:58

Hallo Chris,

allerbesten Dank, es funktioniert! Ich habe schon lange nach der Lösung gesucht.

Vielleicht hast du noch einen Zusatztipp:

Die Auswertungssliste soll nach der Spalte "Name1" sortiert werden von A-Z. Geht zwar einfach über die Sortierung von Excel, aber automatisch mit dem Makro wäre es super.

Schöne Grüße

Markus


  

Betrifft: AW: Liste automatisch neu erstellen und umsortiere von: Herby
Geschrieben am: 27.07.2008 13:50:48

Hallo Markus,


probier mal:


Sub sortieren()
Dim lZ As Long
lZ = Worksheets("Tabelle2").Range("A65536").End(xlUp).Row
Worksheets("Tabelle2").Range("A1:F" & lZ).Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:= _
Range( _
        "C2"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase _
        :=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
        DataOption2:=xlSortNormal
End Sub




Ich habs mit dem Makrorecorder aufgezeichnet.

viele Grüße

Herby


  

Betrifft: AW: Liste automatisch neu erstellen und umsortiere von: Herby
Geschrieben am: 27.07.2008 13:51:50

Hallo Markus,


probier mal:


Sub sortieren()
Dim lZ As Long
lZ = Worksheets("Tabelle2").Range("A65536").End(xlUp).Row
Worksheets("Tabelle2").Range("A1:F" & lZ).Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:= _
Range("C2"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase _
        :=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
        DataOption2:=xlSortNormal
End Sub




Ich habs mit dem Makrorecorder aufgezeichnet.

viele Grüße

Herby


  

Betrifft: AW: Liste automatisch neu erstellen und umsortiere von: Wells
Geschrieben am: 08.09.2008 14:49:15

Hallo Herby,

spät aber besser spät als nie. Besten Dank die Sortierung funktioniert einwandfrei.

Schöne Grüße

Markus


 

Beiträge aus den Excel-Beispielen zum Thema "Liste automatisch neu erstellen und umsortieren"