Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 21:51:33
Idee für Grafik
26.04.2024 21:29:07
PQ zufällige Reihenfolge
26.04.2024 17:18:47
Große Datenmenge in komplexes Diagramm verpacken
26.04.2024 16:22:47
Aktualisierung Verknüpfung bei geschlossener Quelldatei
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1236to1240
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1236to1240
1236to1240
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Code für Liste ohne Doppler, aber waagrecht

Code für Liste ohne Doppler, aber waagrecht
WalterK
Hallo,
ich sollte eine Lösung für folgendes Problem haben:
Zwei senkrechte Listen sollen waagrecht, alphabetisch und ohne Doppler aufgelistet werden.
Die Längen der senkrechten Listen sind variabel.
Hier habe ich eine Beispieldatei erstellt:

Die Datei https://www.herber.de/bbs/user/77480.xls wurde aus Datenschutzgründen gelöscht

Besten Dank für die Hilfe und Servus, Walter

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Code für Liste ohne Doppler, aber waagrecht
13.11.2011 14:35:45
Gerd
Hallo Walter!
Sub test()
Dim X As Variant
X = mitSortedList(Range("D3:D" & Range("D3").End(xlDown).Row).Value)
Cells(1, 21).Resize(1, UBound(X) + 1) = X
X = mitSortedList(Range("E3:E" & Range("E3").End(xlDown).Row).Value)
Cells(2, 21).Resize(1, UBound(X) + 1) = X
End Sub 
Public Function mitSortedList(vntIn As Variant) As Variant
'Quelle: by ransi
Dim L As Long
Dim I As Integer
Dim tmp
Dim objSortedList As Object
Dim objArrayList As Object
Set objArrayList = CreateObject("System.Collections.ArrayList")
Set objSortedList = CreateObject("System.Collections.SortedList")
With objSortedList
For L = LBound(vntIn) To UBound(vntIn)
For I = LBound(vntIn, 2) To UBound(vntIn, 2)
If Not .contains(CStr(vntIn(L, I))) Then .Add CStr(vntIn(L, I)), 0
Next
Next
objArrayList.addrange .keys
mitSortedList = objArrayList.ToArray
End With
Set objSortedList = Nothing
Set objArrayList = Nothing
End Function
Gruß Gerd
Anzeige
AW: Code für Liste ohne Doppler, aber waagrecht
13.11.2011 14:49:51
Peter
Hallo Walter,
so vielleicht:
Option Explicit
Public Sub OhneDuplikate()
Dim objSortedList  As Object
Dim objArrayList   As Object
Dim lngLetzte      As Long
Dim intSpalte      As Integer
Dim lngIndex       As Long
Dim vntArray       As Variant
    
   Set objSortedList = CreateObject(Class:="System.Collections.SortedList")
    
   ThisWorkbook.Worksheets("Tabelle2").Activate ' den Tabellenblattnamen ggf. anpassen!
   
   Range("U1:IV2").ClearContents
   
   For intSpalte = 4 To 5
      lngLetzte = Cells(Rows.Count, intSpalte).End(xlUp).Row
      vntArray = Range(Cells(3, intSpalte), Cells(lngLetzte, intSpalte)).Value2
      
      Set objArrayList = CreateObject("System.Collections.ArrayList")
      objSortedList.capacity = UBound(vntArray)
  
      For lngIndex = 1 To UBound(vntArray)
         If Not IsEmpty(vntArray(lngIndex, 1)) Then _
            objSortedList(vntArray(lngIndex, 1)) = ""
      Next lngIndex
    
      objArrayList.AddRange objSortedList.keys
    
      lngLetzte = objArrayList.Count - 1
      If intSpalte = 4 Then
         Range(Cells(1, 21), Cells(1, 21 + lngLetzte)) = objArrayList.ToArray
       Else
         Range(Cells(2, 21), Cells(2, 21 + lngLetzte)) = objArrayList.ToArray
      End If
      
      Set objArrayList = Nothing
      
   Next intSpalte
   
   Set objSortedList = Nothing
End Sub
Gruß Peter
Anzeige
Danke Gerd und Peter, beides funktioniert bestens.
13.11.2011 15:22:25
WalterK
Servus, Walter

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige