Supportnet / Forum / Tabellenkalkulation

Hallo, ich mal wieder !Sitz schon wieder nen halben Tag an einem Problem das ihr sicherlich aus dem FF löst! Folgendes IST-Bestand: Will einfach eine Zeile mit 160 Spalten (die doppelte AUftragsnr. in Form 7-104.4 enthält oder eben auch leere Felder wie folgt vergleichen: Prüfe die Zeile nach vorhandenen Auftragsnr! Setze diese untereinander "sortiert" im neuen Tabellenblatt ! Dabei sollen die Leeren "natürlich wegfallen" und die doppelten nur einmal vorkommen ! Bsp. in den Spalten sind vorhanden: D9 E9 F9 G9 H9 7-703.2 7-703.1 7-704.1 7-703.2 in einem Neuen Tabellenblatt soll nun erscheinen A1: 7-703.1 A2: 7-703.2 A3: 7-704.1 Die Spalte E9 fällt logischerweise raus, da diese leer ist und H9 würde ja doppelt vorkommen, soll also auch nur 1x gelistet werden. Hoffe konnte das verständlich rüberbringen: Habs schon mit der Formel: =WENN(ZÄHLENWENN probiert, denke ich bin da auch irgendwie auf dem richtigen Weg - aber es haut halt nicht so richtig hin. Hat jemand nen Tip? P.S. wenn das sortieren der Liste größeren AUfwand macht - muss nicht unbedingt sein ;-) Sieht im Endergebnis zwar besser aus, kann aer in der Not auch ohne Sortierung leben Danke für eure Hilfe Gruß Volker

Hallo Volker,

probier's mal mit diesem Code.

Option Explicit

Sub TransponierenSortierenFiltern()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Tabelle1")
    Set ws2 = Worksheets("Tabelle2")
    ws1.Range("FN1").Value = "Titel"
    ws1.Range("A9:FD9").Copy
    ws1.Range("FN2").PasteSpecial Paste:=xlPasteAll, Transpose:=True
    Application.CutCopyMode = False
    ws1.Columns("FN:FN").Sort Key1:=Range("FN2"), Order1:=xlAscending, Header:=xlGuess
    Range("A1").Select
    ws2.Select
    ws1.Columns("FN:FN").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("A1"), Unique:=True
    ws1.Columns("FN:FN").ClearContents
End Sub

Gruß
Rainer

Hallo Rainer,
meine VBA Kenntnisse sind noch nicht so gut
Kannst du mir mal auflschlüssen was du da machst?
Wo muss ich das hinkopieren? in Modul oder in das Arbeitssblatt?

Denke mal "Tabelle1" muss der Name des "Datenarbeitsblatt" Sein
"Tabelle 2" dagegen sollte ein Leeres arbeitsblatt sein?

Wäre nett wenn du vieleicht mal kurz die einzelnen Befehlszeilen aufschlüssen könnten.
Würde gerne verstehen was da passiert und was "ich" da tue mit dem Makro.

Danke für deine Mühe.

Ausserdem würde mich auch eine Lösung in Excel (also ohne VBA) rein interessehalber Interessieren - müsste doch auch irgendwie gehen?

Gruß an alle
Volker

Hallo Volker,

habe das Makro entsprechend der von Dir genannten Tabellennamen geändert und Erläuterungen eingefügt.
Du kannst es mit der Tastenkombination Strg+a starten.

Habe Dir eine Testdatei angehängt, in der ich in A9:FD9 Zufallszahlen als Testobjekt eingefügt habe.

Das Makro kopiert diese Zeile, transponiert sie in die Hilfsspalte FN und sortiert die Daten aufsteigend.

Jetzt werden mittels Spezialfilter die Duplikate entfernt und die Restdaten in das automatisch eingefügte Tabellenblatt "Auswertung" nach Spalte A verschoben.

Zum Schluß wird noch die Hilfsspalte gelöscht.

Das Makro befindet sich im VBE in Modul1. Mit ALT+F11 kannst Du es besichtigen oder ändern.

Eine Formellösung kannst Du Dir aus dem Kopf schlagen, wenn diese möglich ist, dann nur mit unvertretbarem Aufwand, welchen ich mir nicht antue.

Option Explicit

Sub TransponierenSortierenFiltern()
    Dim ws1 As Worksheet, ws2 As Worksheet ' deklariert die Variablen ws1 und ws2
    
    Set ws1 = Worksheets("Datenarbeitsblatt") ' weist der Variablen ws1 den Tabellennamen "Datenarbeitsblatt" zu
    
    ws1.Range("FN1").Value = "Titel" ' erzeugt Spaltenüberschrift in Hilfsspalte FN
    
    Sheets.Add.Name = "Auswertung" ' fügt ein neues Arbeitsblatt namens "Auswertung" ein
    
    Set ws2 = Worksheets("Auswertung") ' weist der Variablen ws2 den Tabellennamen "Auswertung" zu
    
    ws1.Range("A9:FD9").Copy ' kopiert die Datenzeile
    
    ws1.Range("FN2").PasteSpecial Paste:=xlPasteAll, Transpose:=True ' transponiert die Datenzeile in Hilfsspalte FN
    
    Application.CutCopyMode = False ' entfernt den Laufrahmen aus Datenzeile
    
    ws1.Columns("FN:FN").Sort Key1:=ws1.Range("FN2"), Order1:=xlAscending, Header:=xlGuess
    Range("A1").Select
    ' sortiert die Werte der Hilfsspalte aufsteigend und Rücksprung zu A1
    
    ws2.Select
    ws1.Columns("FN:FN").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("A1"), Unique:=True
    'Spezialfilter entfernt Duplikate aus Hilfspalte und verschiebt den Rest nach Tabelle "Auswertung" Spalte A
    
    ws1.Columns("FN:FN").ClearContents 'Hilfsspalte wird gelöscht
    
    ws1.Select
    Range("A1").Select 'Rücksprung in Zelle A1
End Sub

Gruß
Rainer

Hallo Volker,

hier die versprochenn Datei.

http://rapidshare.com/files/134482757/Transponieren.xls.html

Gruß
Rainer

Hi Rainer,
danke für die geniale Beispieldatei, hat zwar einen kleinen Fehler (wehe dem das Makro wurde ausgeführt - das "neue" Blatt erstellt - dann kommt der böse "Debug" - aber das krieg ich hin ;-)
Bedanke mich jedenfalls für deine RIESEN MÜHE !
Und hast mir echt genial weitergeholfen!

Trotzdem wurmt mich immer noch das das ganze nur per VBA funktioniert. OK mein Problem ist gelöst aber ich kann mir nicht Vorstellen, das das ganze nicht mit Sverweis, wverweis, indirekt oder so ählich als direkte Formel zu lösen ist.

Bin halt "wissbegierig".

aber nichts des so trotz - mein Problem konnte ich mit Hilfe von Rainer lösen.
Einfach ein geniales Forum hier - und vor allen Dingen - geniale Leute.
Gruß Volker

Hallo Volker,

sorry, hatte die Abfrage, ob Blatt vorhanden, vergessen.
Hier die Korrektur:

Option Explicit

Sub TransponierenSortierenFiltern()
    Dim ws1 As Worksheet, ws2 As Worksheet, wsNeu As Worksheet ' deklariert die Variablen wsNeu, ws1 und ws2
    Set ws1 = Worksheets("Datenarbeitsblatt") ' weist der Variablen ws1 den Tabellennamen "Datenarbeitsblatt" zu
    ws1.Range("FN1").Value = " " ' erzeugt Spaltenüberschrift in Hilfsspalte FN
    For Each wsNeu In ActiveWorkbook.Worksheets
        If wsNeu.Name = "Auswertung" Then 'Abfrage, ob Blatt vorhanden
            MsgBox "Blatt vorhanden"
            Exit For
        Else
            Sheets.Add.Name = "Auswertung" ' fügt ein neues Arbeitsblatt namens "Auswertung" ein
        End If
    Next
    Set ws2 = Worksheets("Auswertung") ' weist der Variablen ws2 den Tabellennamen "Auswertung" zu
    ws1.Range("A9:FD9").Copy ' kopiert die Datenzeile
    ws1.Range("FN2").PasteSpecial Paste:=xlPasteAll, Transpose:=True ' transponiert die Datenzeile in Hilfsspalte FN
    Application.CutCopyMode = False ' entfernt den Laufrahmen aus Datenzeile
    
    ws1.Columns("FN:FN").Sort Key1:=ws1.Range("FN2"), Order1:=xlAscending, Header:=xlGuess
    Range("A1").Select
    ' sortiert die Werte der Hilfsspalte aufsteigend und Rücksprung zu A1
    ws2.Select
    ws1.Columns("FN:FN").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("A1"), Unique:=True
    'Spezialfilter entfernt Duplikate aus Hilfspalte und verschiebt den Rest nach Tabelle "Auswertung" Spalte A
    ws1.Columns("FN:FN").ClearContents 'Hilfsspalte wird gelöscht
    ws1.Select
    Range("A1").Select 'Rücksprung in Zelle A1
End Sub

Gruß
Rainer

PS: Mich würde auch interessieren, ob sich jemand an eine Formellösung heran traut

• Werte vergleichen
• Werte vergleichen
• Excel Werte Vergleichen
• Excel Werte vergleichen
• Werte einer Spalte vergleichen