Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
18.04.2024 18:04:29
Formel fehler Wert#
18.04.2024 17:45:21
Shellkommando ausführen, stderr auslesen
18.04.2024 17:41:41
Summe: Bestimmter Bereich mit sverweis
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
944to948
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
944to948
944to948
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Listbox userform sort - dauert

Listbox userform sort - dauert
28.01.2008 08:53:00
chris
hallo VBA profis,
ich fülle eine listbox mit werten aus der Tabelle...
Dies sind aber über 5000 Werte.
Das sortieren braucht sehr lange.
Die Exceltabelle darf ich davor nicht sortieren.
habe hier im dforum schon einiges gefunden zum sortieren aber das braucht zieklich lange zum bearbeiten...
Würde mich über eine Lösung freuen.
Vielen Dank
gruß Chris

Private Sub UserForm_Initialize()
'fill listbox with "numbers" nummern
x1 = Obj_Datenbank.Worksheets("AeAS_daten" & version).Cells(Obj_Datenbank.Worksheets(" _
AeAS_daten" & version).Rows.Count, 1).End(xlUp).Row
For x = 3 To x1
Me.numbers_lb.AddItem Obj_Datenbank.Worksheets("AeAS_daten" & version).Cells(x, 1). _
Value
Next
'sortieren einträge nummern
End Sub


11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Listbox userform sort - dauert
28.01.2008 09:27:12
Rudi
Hallo,
erst den Bereich in ein Array einlesen. Dann das Array sortieren. Das Array als Liste nehmen.

Private Sub UserForm_Initialize()
'fill listbox with "numbers" nummern
Dim arrList
With Obj_Datenbank.Worksheets("AeAS_daten" & Version)
x1 = .Cells(.Rows.Count, 1).End(xlUp).Row
arrList = .Range(.Cells(3, 1), .Cells(x1, 1))
End With
QuickSort arrList
Me.numbers_lb.List = arrList
End Sub




Sub QuickSort(ByRef VA_array, Optional V_Low1, Optional V_high1)
On Error Resume Next
Dim V_Low2, V_high2, V_loop As Integer
Dim V_val1, V_val2 As Variant
If IsMissing(V_Low1) Then
V_Low1 = LBound(VA_array, 1)
End If
If IsMissing(V_high1) Then
V_high1 = UBound(VA_array, 1)
End If
V_Low2 = V_Low1
V_high2 = V_high1
V_val1 = VA_array((V_Low1 + V_high1) / 2)
While (V_Low2  V_val1 And _
V_high2 > V_Low1)
V_high2 = V_high2 - 1
Wend
If (V_Low2  V_Low1) Then Call _
QuickSort(VA_array, V_Low1, V_high2)
If (V_Low2


Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe

Anzeige
AW: Listbox userform sort - dauert
28.01.2008 09:32:43
chris
Danke Rudi,
von Dir kommen halt doch immer brauchbare Beiträge !"
gruß Chris

AW: Listbox userform sort - doch noch offen
28.01.2008 09:39:22
chris
Hilfe,
sortieren dauert doch noch sehr lange.
Über 1 minute dann habe ich abgebrochen .. QWas mache ich falsch ?
Hier mein Code in der Form:
Ich hoffe du hilfst mir noch einmal.
Danke

Private Sub UserForm_Initialize()
'fill listbox with "change numbers" Änderungsnummern
Dim arrList
With Obj_Datenbank.Worksheets("AeAS_daten" & version)
x1 = .Cells(.Rows.Count, 1).End(xlUp).Row
arrList = .Range(.Cells(3, 1), .Cells(x1, 1))
End With
QuickSort arrList
Me.changenumbers_lb.List = arrList
x1 = Obj_Datenbank.Worksheets("AeAS_daten" & version).Cells(Obj_Datenbank.Worksheets(" _
AeAS_daten" & version).Rows.Count, 1).End(xlUp).Row
For x = 3 To x1
Me.changenumbers_lb.AddItem Obj_Datenbank.Worksheets("AeAS_daten" & version).Cells(x, 1) _
.Value
Next
'sortieren einträge Änderungsnummern
End Sub




Private Sub abbruch_Click()
Me.Hide
Unload Me
End Sub




Private Sub ok_Click()
End Sub


Sub QuickSort(ByRef VA_array, Optional V_Low1, Optional V_high1)
On Error Resume Next
Dim V_Low2, V_high2, V_loop As Integer
Dim V_val1, V_val2 As Variant
If IsMissing(V_Low1) Then
V_Low1 = LBound(VA_array, 1)
End If
If IsMissing(V_high1) Then
V_high1 = UBound(VA_array, 1)
End If
V_Low2 = V_Low1
V_high2 = V_high1
V_val1 = VA_array((V_Low1 + V_high1) / 2)
While (V_Low2 While (VA_array(V_Low2) V_Low2 V_Low2 = V_Low2 + 1
Wend
While (VA_array(V_high2) > V_val1 And _
V_high2 > V_Low1)
V_high2 = V_high2 - 1
Wend
If (V_Low2 V_val2 = VA_array(V_Low2)
VA_array(V_Low2) = VA_array(V_high2)
VA_array(V_high2) = V_val2
V_Low2 = V_Low2 + 1
V_high2 = V_high2 - 1
End If
Wend
If (V_high2 > V_Low1) Then Call _
QuickSort(VA_array, V_Low1, V_high2)
If (V_Low2 QuickSort(VA_array, V_Low2, V_high1)
End Sub


Anzeige
AW: Listbox userform sort - doch noch offen
28.01.2008 09:43:57
Rudi
Hallo,
warum hast du das

x1 = Obj_Datenbank.Worksheets("AeAS_daten" & version).Cells(Obj_Datenbank.Worksheets(" _
AeAS_daten" & version).Rows.Count, 1).End(xlUp).Row
For x = 3 To x1
Me.changenumbers_lb.AddItem Obj_Datenbank.Worksheets("AeAS_daten" & version).Cells(x, 1) _
_
.Value
Next


in deinen Code eingebaut? Ist vollkommen überflüssig.
Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe

AW: Listbox userform sort - doch noch offen
28.01.2008 09:52:00
chris
Hallo Ridi,
habe jetzt den code entfernt.. Brachte nichts ? Er hämgt sich immer in dieser schleife auf ?
While (VA_array(V_Low2) V_Low2 V_Low2 = V_Low2 + 1
Wend
Hier mein Code

Private Sub UserForm_Initialize()
Dim arrList
With Obj_Datenbank.Worksheets("AeAS_daten" & version)
x1 = .Cells(.Rows.Count, 1).End(xlUp).Row
arrList = .Range(.Cells(3, 1), .Cells(x1, 1))
End With
QuickSort arrList
Me.changenumbers_lb.List = arrList
End Sub




Private Sub abbruch_Click()
Me.Hide
Unload Me
End Sub




Private Sub ok_Click()
End Sub


Sub QuickSort(ByRef VA_array, Optional V_Low1, Optional V_high1)
On Error Resume Next
Dim V_Low2, V_high2, V_loop As Integer
Dim V_val1, V_val2 As Variant
If IsMissing(V_Low1) Then
V_Low1 = LBound(VA_array, 1)
End If
If IsMissing(V_high1) Then
V_high1 = UBound(VA_array, 1)
End If
V_Low2 = V_Low1
V_high2 = V_high1
V_val1 = VA_array((V_Low1 + V_high1) / 2)
While (V_Low2 While (VA_array(V_Low2) V_Low2 V_Low2 = V_Low2 + 1
Wend
While (VA_array(V_high2) > V_val1 And _
V_high2 > V_Low1)
V_high2 = V_high2 - 1
Wend
If (V_Low2 V_val2 = VA_array(V_Low2)
VA_array(V_Low2) = VA_array(V_high2)
VA_array(V_high2) = V_val2
V_Low2 = V_Low2 + 1
V_high2 = V_high2 - 1
End If
Wend
If (V_high2 > V_Low1) Then Call _
QuickSort(VA_array, V_Low1, V_high2)
If (V_Low2 QuickSort(VA_array, V_Low2, V_high1)
End Sub


Anzeige
AW: Listbox userform sort - doch noch offen
28.01.2008 10:26:45
fcs
Hallo Chris,
Alternative zu Rudi's Vorschlag:
Die Liste wird in ein temporäres Tabellenblatt kopiert, sortiert, der Listbox zugeordnet und dann das Blatt wieder gelöscht.
Laufzeit ca. 1 Sekunde. Namen von Tabellenblatt und Listbox im Code muss du noch anpassen
Gruß
Franz 

Private Sub UserForm_Initialize()
Dim Auswahlbox As ListBox, wks As Worksheet, arrListe
Dim wksNeu As Worksheet, Bereich As Range
Set wks = Worksheets("Tabelle1") 'Tabellenblatt mit Listendaten
With wks
Application.ScreenUpdating = False
Set wksNeu = Worksheets.Add
.Range(.Cells(3, 1), .Cells(.Rows.Count, 1).End(xlUp)).Copy
wksNeu.Cells(1, 1).PasteSpecial Paste:=xlValues
End With
With wksNeu
Set Bereich = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
Bereich.Sort key1:=Bereich.Range("a1"), order1:=xlAscending, header:=xlNo
arrListe = Bereich.Value
Set Bereich = Nothing
Application.DisplayAlerts = False
wksNeu.Delete
Application.DisplayAlerts = True
Set wksNeu = Nothing
End With
Me.ListBox1.List = arrListe
Set wks = Nothing
arrListe = ""
End Sub


Anzeige
AW: Listbox userform sort - doch noch offen
28.01.2008 10:33:00
Rudi
Hallo,
Fehler gefunden. Das Array darf nur 1-dimensional sein.

Private Sub UserForm_Initialize()
'fill listbox with "numbers" nummern
Dim arrList, x1
With Obj_Datenbank.Worksheets("AeAS_daten" & Version)
x1 = .Cells(.Rows.Count, 1).End(xlUp).Row
arrList = .Range(.Cells(3, 1), .Cells(x1, 1))
arrList = WorksheetFunction.Transpose(arrList)
End With
QuickSort arrList
Me.numbers_lb.List = arrList
End Sub


Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe

AW: Listbox userform sort - doch noch offen
28.01.2008 10:48:00
chris
VieleN dank !!
und auch denke den mitantwortern !!

Anzeige
AW: Listbox userform sort - zusatz frage
28.01.2008 10:59:00
chris
Hallo zusammen, hallo Rudi,
es hat ja wirklich wunderbar geklappt.Das ganze läuft jetzt in unter 1 sekunde :)
Echt super.
Vielleicht hast du für mich auch noch eine schnelle Lösung für diese frage...
Ich habe auf der Form 2 Optionsbuttons.
Wenn einer geklickt wurde sollen nur die Daten in der Listbox sortiert angezeigt werden die mit F.
beginnen und beim anderen aptionsbutton nur die die mit 5 beginnen.
und dann habe ich noch 2 Optionsfelder wenn der eine angeklickt wirde sollen nur noch die werte angezeigt werden die entweder "wp" im text haben oder die die nur "w" im text haben.
Wäre super wenn es dafür noch eine so schnelle Lösung gibt.
Gruß Christian

Anzeige
AW: Listbox userform sort - zusatz frage
28.01.2008 11:55:00
Rudi
Hallo,
so?

Private Sub OptionButton1_Click()
'beginn mit F
Me.numbers_lb.List = ListArray()
End Sub
Private Sub OptionButton2_Click()
'Beginn mit 5
Me.numbers_lb.List = ListArray()
End Sub
Private Sub OptionButton3_Click()
'wp drin
Me.numbers_lb.List = ListArray()
End Sub
Private Sub OptionButton4_Click()
'w drin
Me.numbers_lb.List = ListArray()
End Sub
Private Sub UserForm_Initialize()
'fill listbox with "numbers" nummern
Me.numbers_lb.List = ListArray()
End Sub
Function ListArray()
Dim arrTmp1, arrTmp2, i As Long, strSuch As String, x1 As Long, n As Long
With Obj_Datenbank.Worksheets("AeAS_daten" & Version)
x1 = .Cells(.Rows.Count, 1).End(xlUp).Row
arrTmp1 = .Range(.Cells(3, 1), .Cells(x1, 1))
arrTmp1 = WorksheetFunction.Transpose(arrTmp1)
End With
ReDim arrTmp2(UBound(arrTmp1))
n = -1
If Not (OptionButton1 Or OptionButton2) Then
ListArray = arrTmp1
Exit Function
Else
If OptionButton1 = True Then
strSuch = "F"
ElseIf OptionButton2 = True Then
strSuch = "5"
Else
strSuch = ""
End If
For i = 1 To UBound(arrTmp1)
If Not (OptionButton3 Or OptionButton4) Then
If Left(arrTmp1(i), 1) = strSuch Then
n = n + 1
arrTmp2(n) = arrTmp1(i)
End If
Else
If OptionButton3 = True Then
If Left(arrTmp1(i), 1) = strSuch And InStr(arrTmp1(i), "wp") > 0 Then
n = n + 1
arrTmp2(n) = arrTmp1(i)
End If
Else
If Left(arrTmp1(i), 1) = strSuch And InStr(arrTmp1(i), "wp") = 0 And InStr(arrTmp1( _
i), "w") > 0 Then
n = n + 1
arrTmp2(n) = arrTmp1(i)
End If
End If
End If
Next i
If n > -1 Then
ReDim Preserve arrTmp2(n)
QuickSort arrTmp2
ListArray = arrTmp2
Else
ListArray = Array("")
End If
End If
End Function


Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe

Anzeige
AW: Listbox userform sort - zusatz frage
28.01.2008 13:15:00
chris
respekt,
Dane vielmals und noch einen schönen Tag wünsche ich !!!!!!
gruß Chris

Links zu Excel-Dialogen

ListBox OptionButton

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige