Code braucht sehr lange zum Einlesen der Daten

Sub sbFillCmb() 'fülle die Raumbox auf Dim lloRow As Long, liIdx As Integer, larstrCmb() As String, lboExist As Boolean ReDim larstrCmb(0) With Sheets("Bearbeiten") For lloRow = 1 To .Cells(.Rows.count, 2).End(xlUp).Row For liIdx = 0 To UBound(larstrCmb) If .Range("B" & lloRow).Value = larstrCmb(liIdx) Then lboExist = True Exit For End If Next If lboExist = True Then lboExist = False Else larstrCmb(UBound(larstrCmb)) = .Range("B" & lloRow).Value ReDim Preserve larstrCmb(UBound(larstrCmb) + 1) End If Next On Error Resume Next 'wegen Neu und Leer-Unrelevanter Fehler ReDim Preserve larstrCmb(UBound(larstrCmb) - 1) For liIdx = 0 To UBound(larstrCmb) UserForm105.ComboBox00094X.AddItem larstrCmb(liIdx) Next End With End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub sbFillCmb() 'fülle die Raumbox auf Dim lloRow As Long, liIdx As Integer, larstrCmb() As String, lboExist As Boolean Dim vntListe As Variant ReDim larstrCmb(0) With Sheets("Bearbeiten") vntListe = .Range(.Cells(1, 2), .Cells(.Rows.Count, 2).End(xlUp)).Value End With For lloRow = 1 To UBound(vntListe, 1) For liIdx = 0 To UBound(larstrCmb) If vntListe(lloRow, 1) = larstrCmb(liIdx) Then lboExist = True Exit For End If Next If lboExist = True Then lboExist = False Else larstrCmb(UBound(larstrCmb)) = vntListe(lloRow, 1) ReDim Preserve larstrCmb(UBound(larstrCmb) + 1) End If Next On Error Resume Next 'wegen Neu und Leer-Unrelevanter Fehler ReDim Preserve larstrCmb(UBound(larstrCmb) - 1) For liIdx = 0 To UBound(larstrCmb) UserForm105.ComboBox00094X.AddItem larstrCmb(liIdx) Next End Sub

HI
so wie ich das sehe, willst du die Raumnummern ohne Duplikate in der der Reihenfolge, wie sie in der Liste vorkommen in der Combobox.
Wenn die Angaben von Mikrosoft stimmen ( was leider nicht immer der Fall ist), dann verfügt dein Excel über die Funktion EINDEUTIG.
Diese könntest du hier nutzen, was die Sache ganz einfach macht:

Private Sub UserForm_Initialize()

    ComboBox00094X.List = WorksheetFunction.Unique(Range(Cells(1, 2), Cells(1, 2).End(xlDown)))

End Sub

auch sortiert wäre kein Problem, wenn dein Excel schon über die Funtion SORTIEREN verfügt (Microsoft sagt so, muss aber nicht stimmen)

Private Sub UserForm_Initialize()

    ComboBox00094X.List = WorksheetFunction.Sort(WorksheetFunction.Unique(Range(Cells(1, 2), Cells(1, 2).End(xlDown))))

End Sub

wenn nicht könntest du die Inhalte in eine freie Spalte kopieren, dort das Duplikate-Entfernen und ggf das Sortieren anwenden (zwei einfach Excelmenüfunktionen, die jeder kennen sollte)
Hier also der Weg über die Excelmenüfunktionen, bei WITH Columns(9) solltest du eine freie Spalte rechts der Daten angeben, die temporeär genutzt werden kann, auch die Spalten links und rechts daneben sollten leer sein.

Private Sub UserForm_Initialize()

    With Columns(9)

        Columns(2).Copy .Cells

        .RemoveDuplicates 1, xlNo

        .Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlNo

        ComboBox00094X.List = .CurrentRegion.Value

        .Clear

    End With

End Sub

um duplikat-Freie Listen zu erstellen kann man die Listbox auch selber nutzen mit wenig aufand.

nicht ganz so schnell, aber probrammiertechnisch auch sehr einfach wäre es, die Combobox selbst für die Duplikatsprüfung zu nutzen:

Private Sub UserForm_Initialize()

Dim c As Long

Dim Raum

With ComboBox00094X

    For Each Raum In Range(Cells(1, 2), Cells(1, 2).End(xlDown)).Value

        For c = 0 To .ListCount - 1

            If .List(c) = CStr(Raum) Then Exit For

        Next

        If c = .ListCount Then .AddItem CStr(Raum)

    Next

End With

End Sub

und auch damit ließen sich sogar gleich sortierte Listen erstellen.

Private Sub UserForm_Initialize()

Dim c As Long

Dim Raum, R As String

With ComboBox00094X

    For Each Raum In Range(Cells(1, 2), Cells(1, 2).End(xlDown)).Value

        R = CStr(Raum)

        For c = 0 To .ListCount - 1

            If .List(c) >= R Then Exit For

        Next

        If c = .ListCount Then

            .AddItem R

        Else

            If .List(c) > R Then .AddItem R, c

        End If

    Next

End With

End Sub

Gruß Daniel

Sub sbFillCmb() 'fülle die Raumbox auf Dim lloRow As Long Dim objCBXList As Object, vntARR Dim t t = Timer Set objCBXList = CreateObject("scripting.dictionary") With Sheets("Bearbeiten") vntARR = .Range(.Cells(2, 2), .Cells(Rows.Count, 2).End(xlUp)).Value End With For lloRow = 1 To UBound(vntARR) objCBXList(vntARR(lloRow, 1)) = 0 Next lloRow UserForm105.ComboBox00094X.List = Application.Transpose(objCBXList.keys) Debug.Print Timer - t End Sub

ich weiß dass der Code von Udo schnell ist, ich nutze das auch gerne.
nur sortieren kann man so nicht.
aber seit dem man die Excelfunktion EINDEUTIG verwenden kann, braucht man das Dictionary zum Entfernen von Duplikaten in einem Array nicht mehr, weil man das jetzt mit einem Befehl machen kann (trotzdem sollte man sich das Dictionary-Objekt merken, weil man damit auch viele andere schöne Sachen machen kann, wenn es darum geht, Listen und Tabellen zu bearbeiten, umzuformen oder auszuwerten)
Und wenn man EINDEUTIG als Excelfunktion hat, hat man auch SORTIEREN um die Daten dann noch im Array zu sortieren, dafür gabs bisher in VBA auch noch keinen Befehl (es gab das Objekt ArrayList, aber das war nie so richtig in der Hilfe dokumentiert)
also der Codeauschnitt, den du hier zeigst, ersetzt den Code von Udo vollständig und sortiert dabei auch noch.
Gruß Daniel

Dim objDic As Object, Zelle As Range Set objDic = CreateObject("Scripting.Dictionary") With Sheets("Bearbeiten") For Each Zelle In .Range("C1:C" & .Cells(Rows.count, 3).End(xlUp).Row) objDic(Zelle.Value) = 0 Next ComboBox719.List = objDic.keys Set objDic = Nothing End With

Beliebteste Forumthreads (12 Monate)

Code braucht sehr lange zum Einlesen der Daten

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Code braucht sehr lange zum Einlesen der Daten

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread