Supportnet / Forum / Tabellenkalkulation
Selektion aller Werte einer Spalte ohne doppelte Werte
Frage
Hi!
Ich habe folgendes Problem:
Ich müsste aus einer Spalte (Y) der Tabelle 1 alle Werte selektieren. In dieser Spalte stehen oft die selben Werte (es sind Fehlernummern).
Als Ergebnis sollte in einer andern Spalte (in Tabelle2)
jeweils einmal jeder vorkommende Eintrag aus der ursprünglichen Spalte vorkommen. Dabei darf keiner der Einträge doppelt vorkommen, es dürfen keine leeren Zellen zwischen den Werten stehen. Eine Sortierung nach Fehlernummer wär auch nicht schlecht.
Ich bin relativ neu dabei und befasse mich erst seit kurzem mit Excel. Dennoch habe ich zwei Bücher gelesen und keine Lösung gefunden...
Gibt es eine Exel Funktion / Kombination die mir helfen kann?
Vielen Dank schon einmal!
Klamsy
Antwort 1 von nighty
hi klamsky :)
wie gewuenscht :))
gruss nighty
Option Explicit
Sub makro01()
Dim suche As Range
Dim zaehler As Long
zaehler = 2
Sheets(2).Range("A2:A65535").Clear
Do
Set suche = Sheets(1).Range("Y" & (zaehler + 1) & ":Y" & _
Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Find(Cells(zaehler, 25), LookIn:=xlValues)
If Not suche Is Nothing Then
If zaehler = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row Then Exit Do
zaehler = zaehler + 1
Else
Sheets(1).Cells(zaehler, 25).Copy _
Sheets(2).Range("A" & Sheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
If zaehler = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row Then Exit Do
zaehler = zaehler + 1
End If
Loop
Sheets(2).Rows("2:" & Sheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row). _
Sort Key1:=Sheets(2).Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub
wie gewuenscht :))
gruss nighty
Option Explicit
Sub makro01()
Dim suche As Range
Dim zaehler As Long
zaehler = 2
Sheets(2).Range("A2:A65535").Clear
Do
Set suche = Sheets(1).Range("Y" & (zaehler + 1) & ":Y" & _
Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Find(Cells(zaehler, 25), LookIn:=xlValues)
If Not suche Is Nothing Then
If zaehler = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row Then Exit Do
zaehler = zaehler + 1
Else
Sheets(1).Cells(zaehler, 25).Copy _
Sheets(2).Range("A" & Sheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
If zaehler = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row Then Exit Do
zaehler = zaehler + 1
End If
Loop
Sheets(2).Rows("2:" & Sheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row). _
Sort Key1:=Sheets(2).Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub
Antwort 2 von Saarbauer
Hallo,
die Lösung von @ nighty ist eine VBA-Lösung, aber es geht auch anders, sieh den Thread mal an
https://supportnet.de/threads/1237986
und die Verlinkungen dadrin.
Gruß
Helmut
die Lösung von @ nighty ist eine VBA-Lösung, aber es geht auch anders, sieh den Thread mal an
https://supportnet.de/threads/1237986
und die Verlinkungen dadrin.
Gruß
Helmut
Antwort 3 von klamsy
Vielen Dank nighty!
Eingefügt auf ausführen gedrückt -> fertig: Perfekt!
Den Thread
https://supportnet.de/threads/1237986
Habe ich mir schon angesehen, aber irgendwie klappt es bei mir so nicht wegen einem Zirkulationsfehler... vielleicht habe ich auch einen Fehler gemacht..
Naja jetzt werd ich mir mal den Code von nighty ansehen damit ich auch was dabei gelernt hab :)
danke!
Eingefügt auf ausführen gedrückt -> fertig: Perfekt!
Den Thread
https://supportnet.de/threads/1237986
Habe ich mir schon angesehen, aber irgendwie klappt es bei mir so nicht wegen einem Zirkulationsfehler... vielleicht habe ich auch einen Fehler gemacht..
Naja jetzt werd ich mir mal den Code von nighty ansehen damit ich auch was dabei gelernt hab :)
danke!