VBA: Markierter Wert aus Listbox in aktive Zelle
30.09.2003 16:03:24
Moritz
folgende Fragestellung: Eine 3-spaltige Originalliste wird laufend um neue Projekte erweitert. Auf einem weiteren Arbeitsblatt erscheinen die Projekte in Spalte A verkettet. Nun sollen die Projekte über eine Auswahlliste, sortiert und ohne Leerzeilen dargestellt werden. Klappt mittles der untenstehenden Formel tadellos.
Weiter soll der markierte Wert per Klick auf den Button 'OK' in die aktive Zelle des Arbeitsblatts übertragen werden. Das dazugehörige Formular (ListBoxSort) besteht aus einer ListBox und einem OK Button. Hier komme ich nicht weiter! Was müßte man dem OK Button formeltechnisch mitteilen, um den jeweils markierten Wert per Klick in die jeweils aktive Zelle auf dem Arbeitsblatt übertragen zu können?
Sub ShowTheForm()
ListboxSort.Show
End Sub
-----
Sub SortAndRemoveDupes()
Dim rListSort As Range, rOldList As Range
Dim strRowSource As String
'Clears Hidden sheet Column A ready for list
Sheet1.Range("A1", Sheet1.Range("A65536").End(xlUp)).Clear
'Sets range variable to list we want
Set rOldList = Sheet2.Range("A1", Sheet2.Range("A65536").End(xlUp))
'Uses AdvancedFilter to copy the list to Column A _
of the hidden sheet and remove all dupes
rOldList.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheet1.Cells(1, 1), Unique:=True
'Sets range variable to the new non dupe list
Set rListSort = Sheet1.Range("A1", Sheet1.Range("A65536").End(xlUp))
With rListSort
'Sorts the new non dupe list
.Sort Key1:=.Cells(2, 1), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
'Parses the address of the sorted unique items
strRowSource = Sheet1.Name & "!" & Sheet1.Range _
("A2", Sheet1.Range("A65536").End(xlUp)).Address
Sheet1.Range("A1") = "akanto -- Neu sortierte Projektbudgetliste"
With ListboxSort.ListBox1
'Clears old ListBox RowSource
.RowSource = vbNullString
'Parses new one
.RowSource = strRowSource
End With
End Sub