Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Formel für Sortieren ohne Duplikate!
#11
Hallo Atilla,


Zitat:Einen optimalen Code habe ich oben doch schon eingestellt.


das habe ich ja völlig übersehen gestern, soooooryyyy! :) War doch etwas warm gestern... :)

Der Code funktionier super, aber ich möchte nur die Werte in Spalte N im Tabellenblatt LN haben ohne die Formatierungen Farben etc... haben!

Wie geht das?

Vielen Dank
LG
Alexandra
Antworten Top
#12
Hallo Alexandra,

der Spezialfilter nimmt alles mit. Aber man kann die Formate einfach nachträglich löschen.
Unten der Code mit Kommentaren und der Ergänzung zum Löschen der Formate:

Code:
Sub Makro1()
  
   Dim lngLetzte As Long
  
   Worksheets("LN").Columns("N").ClearContents 'Inhalte der Spalte N in Tabelle "LN" löschen
  
  'Mit dem Spezialfilter Spalte AO aus Tabelle "Produkte" ohne Duplikate
  'in Spalte N der Tabelle "LN" kopieren
   With Sheets("Produkte")
      lngLetzte = .Cells(.Rows.Count, "AO").End(xlUp).Row
       Sheets("Produkte").Range("AO1:AO" & lngLetzte).AdvancedFilter Action:=xlFilterCopy, _
           CopyToRange:=Sheets("LN").Range("N1"), Unique:=True
   End With
  
  'aufgezeichneter und nachbehandelter Code zum Sortieren der Spalte N
   With Sheets("Ln")
      lngLetzte = .Cells(.Rows.Count, "N").End(xlUp).Row
      .Range("N1:N" & lngLetzte).ClearFormats   'Formate löschen
       .Sort.SortFields.Clear
       .Sort.SortFields.Add Key:=Range("N1"), _
           SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
      With .Sort
          .SetRange Range("N1:N" & lngLetzte)
          .Header = xlYes
          .MatchCase = False
          .Orientation = xlTopToBottom
          .SortMethod = xlPinYin
          .Apply
      End With
      lngLetzte = .Cells(.Rows.Count, "N").End(xlUp).Row
   End With
  
   'ab hier Code zum Füllen einer Combobox aus Spalte N der Tabelle "LN"
   With ComboBox41
      .ListRows = 12 'Anzahl der Dropdownlist Einträge
      .Clear
      .List = ThisWorkbook.Worksheets("Ln").Range("N2:N" & lngLetzte).Value  'Bereich N2:N bis letzte Zeile aus Tabelle Liste in Combobox einlesen
      .Style = fmStyleDropDownCombo 'freie Eintragungen möglich
      '.ListIndex = 1  'Setze combobox auf ersten Eintrag
   End With
  
End Sub
Gruß Atilla
[-] Folgende(r) 1 Nutzer sagt Danke an atilla für diesen Beitrag:
  • cysu11
Antworten Top
#13
Hi Atilla,


perfekt, ich dank dir sehr!


LG
Alexandra
Antworten Top
#14
Hi,

einen hätte ich noch ;) und das sauschnell, leicht anpassbar und relevant dokumentiert, der Ursprungscode war mal von User RANSI und ist von mir angepasst worden.

Code:
Option Explicit
'In mein Tabellenblatt "LN" möchte ich in Stalte N ab N2 die Begriffe aus Spalte AO aus dem Tabellenblatt "Produkte" alphabetisch sortieren und ohne Duplikate auflisten!
Public Sub test()
Dim objSL As Object, objAR As Object, objDic As Object, ArrDat As Variant
Dim lngI As Long
Const strSearchCol As String = "AO" 'Spalte der doppelten Einträge
Const strOutputCol As String = "N" 'Spalte der Ausgabe
Dim shS As Worksheet, shO As Worksheet, IntRow As Integer, intOutputRow As Integer
Set shS = Sheets("Produkte") 'ggf Codenamen verwenden
Set shO = Sheets("LN")
IntRow = 2 'ab welcher Zeile beginnen die Daten die ausgewertet werden sollen
intOutputRow = 2 'ab welcher Zeile soll eingefügt werden
Set objDic = CreateObject("Scripting.Dictionary")
Set objAR = CreateObject("System.Collections.Arraylist")
Set objSL = CreateObject("System.Collections.Sortedlist")

With shS
    ArrDat = .Range(.Cells(IntRow, strSearchCol), .Cells(.Rows.Count, strSearchCol).End(xlUp))
End With

For lngI = LBound(ArrDat) To UBound(ArrDat)
    If Not objDic.exists(ArrDat(lngI, 1)) And ArrDat(lngI, 1) <> "" Then
        objSL(ArrDat(lngI, 1)) = objSL(ArrDat(lngI, 1))
    End If
Next

objAR.addrange objSL.keys

With shO
    .Cells(intOutputRow, strOutputCol).Resize(objAR.Count) = WorksheetFunction.Transpose(objAR.toArray)
End With

Set objSL = Nothing
Set objAR = Nothing
Set objDic = Nothing
Set shS = Nothing
Set shO = Nothing
End Sub
lg Chris
Feedback nicht vergessen.
[Bild: v.gif]
3a2920576572206973742064656e20646120736f206e65756769657269672e
Antworten Top
#15
Hallo Chris,

in der Tat, diese Variante ist auch sehr schnell aber bei größeren Datenmengen
ist der Spezialfilter etwas schneller. Blush

Du musst noch zwei Zeilen Code ergänzen, um die Sortierung noch einzubauen.
Gruß Atilla
Antworten Top
#16
Hi,

du meinst wahrscheinlich das .sort
hatte ich zuerst drinnen bis ich gemerkt habe das aufsteigend sortiert anscheinend ein Default der Sortlist ist. Aber vielleicht liege ich da ja falsch, bei mir wird sortiert ausgegeben.

Ich habe es zwar nicht getestet, aber von der Geschwindigkeit müsste gegenüber dem Spezialfilter praktisch kein Unterschied sein. (wahrscheinlich auch schneller da die Daten ja nicht an ein Tabellenblatt übergeben werden müssen, denn das frisst die Laufzeit)

Da diese Daten ja zumeist in Comboboxen, Listfeldern benötigt werden liegt der große Vorteil dabei das keine Daten zuerst irgendwo in welchen Tabellen geschrieben werden müssen.
Das geht über den Spezialfilter nicht, wenn ich mich nicht täusche.
lg Chris
Feedback nicht vergessen.
[Bild: v.gif]
3a2920576572206973742064656e20646120736f206e65756769657269672e
[-] Folgende(r) 1 Nutzer sagt Danke an chris-ka für diesen Beitrag:
  • cysu11
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste