ComboBox mit Teil einer Liste füllen

[Rabe]

Hallo,

ich habe eine Liste in Spalte I, die momentan folgendermaßen aussieht:

Datenbankliste

	I
2	R027/2016
3	A028/2016
4	R031/2016
5	R032/2016
6	R033/2016
7	R034/2016
8	A035/2016

Excel-Inn.de

Hajo-Excel.de

XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007

Add-In-Version 19.08 einschl. 64 Bit

mit diesem Makro fülle ich eine ComboBox mit den Daten:

Private Sub UserForm_Initialize()
   Dim objWs As Worksheet
   Dim objZeile As Range
   Set objWs = ThisWorkbook.Worksheets("Datenbankliste")
   
   loLetzte = objWs.Cells(Rows.Count, 1).End(xlUp).Row                     ' letzte belegte in Spalte A (1) 
   ComboBox1.RowSource = "Datenbankliste!I2:I" & loLetzte
   Set objWs = Nothing
   Set objZeile = Nothing
End Sub

Wie mache ich es, daß mir nur die aufgelistet werden, die mit einem A beginnen?

[RPP63]

Moin Ralf!
Auf Anhieb fallen mir zwei Lösungen ein:

1. Durchschleife den Bereich und weise einen neuen Eintrag so zu:
   
   Code:

   Sub RPP()
Dim L As Long
With Worksheets("Datenbankliste")
  For L = 2 To .Cells(2, 9).End(xlDown).Row
     If Left(.Cells(L, 9), 1) = "A" Then
        ComboBox1.AddItem .Cells(L, 9)
     End If
  Next
End With
End Sub
   
   
   
2. Oder Du filterst den Bereich und übergibst die SpecialCells(xlCellTypeVisible) per ComboBox1.List = …
   

Gruß Ralf

[RPP63]

Zur zweiten Variante:
Sie funktioniert nur, wenn der Bereich für .List nicht fragmentiert ist.
Daher wäre ein vorheriges Sortieren notwendig.
Da der Code ja doch etwas länger ist und Deine ehemalige Sortierung verändert, bietet er sich nur bei sehr großen Datenmengen an, da erheblich schneller als Variante 1

Sub RPP2()
Dim L As Long
ComboBox1.Clear
With Worksheets("Datenbankliste").Columns(9)
   L = .Cells(2).End(xlDown).Row
   .Sort .Cells(2), Order1:=xlAscending, Header:=xlYes
   .AutoFilter 1, "=A*"
   ComboBox1.List = Range(.Cells(2), .Cells(L)).SpecialCells(xlCellTypeVisible).Value
   .AutoFilter
End With
End Sub

Eine andere Variante wäre ein Auslesen aus einem temporären Array gemäß Variante 1

Gruß Ralf

[Kuwer]

Hallo,

Private Sub UserForm_Initialize()
 Dim loLetzte As Long
 Dim objWs As Worksheet
 
 Set objWs = ThisWorkbook.Worksheets("Datenbankliste")
 loLetzte = objWs.Cells(Rows.Count, 9).End(xlUp).Row
 With ComboBox1
   .List = objWs.Range("I2:I" & loLetzte).Value
   For i = .ListCount - 1 To 0 Step -1
     If Left(.List(i), 1) <> "A" Then .RemoveItem i
   Next i
 End With
End Sub

Gruß Uwe

[Rabe]

Hi,

vielen Dank euch allen, ich habe die 1. Version von Ralf verwendet!

[RPP63]

Moin Ralf!

Schneller ist Uwes Lösung, obwohl sie meiner ja scheinbar gleicht.
Bei mir werden einzelne Zellen überprüft und bei erfüllter Voraussetzung wird ein Item in die ComboBox geschrieben.

Bei Uwe wird ein Zellbereich en bloc in die CB geschrieben und bei nicht erfüllter Voraussetzung wird das Item gelöscht.

Unterschied:
Die Liste befindet sich bei Uwe als Quasi-Array im Arbeitsspeicher, bei mir bremsen einzelne Zellzugriffe aus.

Ich nehme zwar an, dass dies bis 1000 Einträgen eher eine akademische Diskussion ist, aber meine Meinung wollte ich dennoch kundtun.  :19:

Gruß Ralf

[Kuwer]

Hallo Ralf (RPP63),

leider muss ich Dir widersprechen.  :22:
Ich habe es eben mal verglichen > Combo- und ListBoxen sind schnarchlangsam. Langsamer als vergleichbare Zellzugriffe.
Richtige Arrays dagegen sind unschlagbar.
Hier mal mein Testform:

Dialog UserForm1

Option Explicit 

Private Sub CommandButton1_Click() 
 Dim dblZ As Double 
 Dim L As Long 

 dblZ = Timer 
 With Worksheets("Datenbankliste") 
   For L = 2 To .Cells(2, 9).End(xlDown).Row 
      If Left(.Cells(L, 9), 1) = "A" Then 
         ComboBox1.AddItem .Cells(L, 9) 
      End If 
   Next 
 End With 
 Label1 = Format(Timer - dblZ, "#0.### s") 
End Sub 

Private Sub CommandButton2_Click() 
 Dim dblZ As Double 
 Dim i As Long 
 Dim loLetzte As Long 
 Dim objWs As Worksheet 

 dblZ = Timer 
 Set objWs = ThisWorkbook.Worksheets("Datenbankliste") 
 loLetzte = objWs.Cells(2, 9).End(xlDown).Row 
 With ComboBox1 
   .List = objWs.Range("I2:I" & loLetzte).Value 
   For i = .ListCount - 1 To 0 Step -1 
     If Left(.List(i), 1) <> "A" Then .RemoveItem i 
   Next i 
 End With 
 Label2 = Format(Timer - dblZ, "#0.### s") 
End Sub 

Private Sub CommandButton3_Click() 
 Dim loLetzte As Long, i As Long, j As Long 
 Dim objWs As Worksheet 
 Dim dblZ As Double 
 Dim varI As Variant, varO As Variant 

 dblZ = Timer 
 Set objWs = ThisWorkbook.Worksheets("Datenbankliste") 
 loLetzte = objWs.Cells(2, 9).End(xlDown).Row 
 varI = objWs.Range("I2:I" & loLetzte).Value 
 Redim varO(Ubound(varI, 1)) 
 For i = 1 To Ubound(varI, 1) 
   If Left(varI(i, 1), 1) <> "A" Then 
     varO(j) = varI(i, 1) 
     j = j + 1 
   End If 
 Next i 
 Redim Preserve varO(j - 1) 
 ComboBox1.List = varO 
 Label3 = Format(Timer - dblZ, "#0.### s") 
End Sub 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 14 - mit VBAHTML 12.6.0

Typ	Name	Eigenschaften
ComboBox	ComboBox1	Height: 18 Left: 18 Top: 18 Width: 138
CommandButton	CommandButton1	Caption: Ralf Height: 24 Left: 180 TabIndex: 1 Top: 18 Width: 72
CommandButton	CommandButton2	Caption: Uwe 1 Height: 24 Left: 264 TabIndex: 2 Top: 18 Width: 72
CommandButton	CommandButton3	Caption: Uwe 2 Height: 24 Left: 348 TabIndex: 5 Top: 18 Width: 72
Label	Label1	Caption: Height: 18 Left: 180 TabIndex: 3 Top: 54 Width : 72
Label	Label2	Caption: Height: 18 Left: 264 TabIndex: 4 Top: 54 Width : 72
Label	Label3	Caption: Height: 18 Left: 348 TabIndex: 6 Top: 54 Width : 72

Teste es mal mit 65000 und 200000 Zellen.

Gruß Uwe

[RPP63]

@Uwe:
:17:
Dann war diese meine Aussage offensichtlich falsch:

Unterschied:
Die Liste befindet sich bei Uwe als Quasi-Array im Arbeitsspeicher, bei mir bremsen einzelne Zellzugriffe aus.

Jetzt bliebe nur noch zu klären, inwiefern Excel-Bordmittel (sortieren, filtern, sichtbare Zellen in die CB) sich verhalten.
Ich führe ganz gerne diese "akademischen" Diskussionen, auch, weil sie teilweise zu unerwarteten Ergebnissen führen, wie man sieht.

(Als Beispiel: Range1.Copy: Range2.PasteSpecial xlPasteValues ist erheblich schneller als Range2.Value = Range1.Value)

Komme aber erst später dazu …

Gruß Ralf

[Rabe]

Hi Ralf,

Schneller ist Uwes Lösung, obwohl sie meiner ja scheinbar gleicht.

ok, dann nehme ich seine.

Jetzt noch zusätzliche Fragen:
Wie bekomme ich jetzt die Zeilennummer der Zeile raus, in dem der gesuchte Begriff gefunden wurde?
listindex kann ich ja nicht nehmen, denn das ist der Index der ComboBox-Liste, die nur die mit "A" enthält.
Momentan lasse ich zum Weiterprogrammieren noch die gesamte Liste in der Combobox erscheinen.

Wenn ich die Daten an die Eingabe-Userform weitergeben will mit folgendem Code:

Code:

Private Sub okButton1_Click()              ' Übernehmen
  Dim objWs As Worksheet
 
  Set objWs = ThisWorkbook.Worksheets("Datenbankliste")
 
  boAbbruch = False
 
  If ComboBox1.ListIndex >= 0 Then
     Zeile = ComboBox1.ListIndex + 2
     
     strKFZKennz = objWs.Cells(Zeile, 1)
     msgbox (strKFZKennz)
     
     With frm_Eingabe
     
        For i = 1 To 8                                       'Kundendaten
           .Controls("Textbox" & i) = objWs.Cells(Zeile, i)
        Next i
       
        For i = 9 To 11                                      'Kfz-Daten
           .Controls("Textbox" & i) = objWs.Cells(Zeile, i + 3)
        Next i
       
        .Controls("Combobox1") = strKFZKennz
        .Controls("Combobox2") = "Rechnung"
        .Controls("Textbox100") = "R" & Mid(objWs.Cells(Zeile, 9), 2, 8)
       
        For i = 15 To 25                                  ' Arbeitsgang 1 - 11
           .Controls("Textbox" & i) = objWs.Cells(Zeile, i)
        Next i
        For i = 26 To 36                                  ' Arbeitswert zu Arbeitsgang 1 - 11
           .Controls("Textbox" & i + 75) = objWs.Cells(Zeile, i)
        Next i
        For i = 37 To 47                                  ' Einzelpreis zu Arbeitsgang 1 - 11
           .Controls("Textbox" & i + 164) = objWs.Cells(Zeile, i)
        Next i
        For i = 48 To 58                                  ' Euro-Betrag zu Arbeitsgang 1 - 11
           .Controls("Textbox" & i + 253) = objWs.Cells(Zeile, i)
        Next i
        .Controls("Textbox200") = objWs.Cells(Zeile, 59)
       
     End With
     
     Unload frm_Anzeige
     frm_Eingabe.Show
  End If
End Sub

wird das strKFZKennz in der Messagebox korrekt angezeigt und die Inhalte ("Arbeitsgänge" ff) ab

Code:

        .Controls("Combobox2") = "Rechnung"

werden auch korrekt angezeigt, aber die Kunden- und Kfz-Daten (Textboxen 1-11) dazwischen erscheinen gar nicht.

Der Start-Code hinter dem Eingabe-Userform sieht so aus:

Code:

Option Explicit

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)    'schließen über "X" verhindern
  If CloseMode = vbFormControlMenu Then
  End If
End Sub

Private Sub UserForm_Activate()
  '     Me.Height = Application.Height
  '     Me.Width = Application.Width
 
 
  Dim lngLastRow As Long
  lngLastRow = ThisWorkbook.Worksheets("Adressen").Range("A" & Rows.Count).End(xlUp).Row
  With Me.ComboBox1
     .RowSource = "Adressen!A1:A" & lngLastRow
     .ListIndex = 0
     .SetFocus: .SelStart = 1: .SelLength = Len(.Text)
  End With
  With ComboBox2
     .AddItem "Angebot"
     .AddItem "Rechnung"
  End With
 
  'Datum und Uhrzeit anzeigen
  Label18.Caption = Format(Date, "dddd, dd.mm.yyyy")
 
  Bol = True
  Do Until Bol = False
     DoEvents
     Label19.Caption = Time
  Loop
End Sub

Wird beim Aufruf der Eingabe-UF der vorher übergebene Wert in der ComboBox1 (strKFZKennz) überschrieben und dann ist nix mehr ausgewählt und deswegen werden keine Daten angezeigt?
Wie kann ich das verhindern?

[RPP63]

Hi!

Wie bekomme ich jetzt die Zeilennummer der Zeile raus, in dem der gesuchte Begriff gefunden wurde?

Ich würde dies mit 
WorksheetFunction.Match(CB1.Text, Columns(9), 0)
erledigen.

Magst Du uns eine Datei zur Verfügung stellen.
(Ich habe mir Deinen Code noch nicht angeschaut, komme erst gegen frühen Abend dazu)

Gruß Ralf