Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
02.03.2022 14:47:12 |
Eric |
|
|
|
02.03.2022 16:08:18 |
Gast64353 |
|
|
|
03.03.2022 08:29:07 |
Eric |
|
|
|
03.03.2022 09:27:35 |
Gast512 |
|
|
|
03.03.2022 09:34:56 |
Gast19248 |
|
|
|
03.03.2022 12:37:26 |
Gast99240 |
|
|
|
03.03.2022 12:47:43 |
Eric |
|
|
|
03.03.2022 18:49:44 |
ralf_b |
|
|
|
04.03.2022 07:48:28 |
Eric |
|
|
Comboxen Automatisch füllen |
04.03.2022 10:15:35 |
Gast22599 |
|
|
|
07.03.2022 07:42:02 |
Gast93871 |
|
|
Von:
Gast22599 |
Datum:
04.03.2022 10:15:35 |
Views:
950 |
Rating:
|
Antwort:
|
Thema:
Comboxen Automatisch füllen |
Mit Excel 365 hast du das Glück das es einige Funktionen bietet, die man in anderen Versionen händisch umsetzen müsste.
ralf_b hat bereits ein Paar genannt.
Folgender Code gehört in die Tabelle, in welcher sich die Tabelle befindet:
Es wird davon ausgegangen das die Tabelle in A1 beginnt.
Option Explicit
Public Sub Anwendungsbeispiel()
Dim vntValues As Variant
Call GetUniqueCarBrands(vntValues)
ComboBox1.List = vntValues
If ComboBox1.ListCount = 0 Then
Exit Sub
End If
'ersten Eintrag vor-auswählen
ComboBox1.ListIndex = 0
End Sub
Private Sub ComboBox1_Change()
If ComboBox1.ListIndex < 0 Then Exit Sub
Dim vntValues As Variant
'Inhalt von ComboBox2 aktualisieren, wenn in ComboBox1 sich die Auswahl ändert
Call GetUniqueCarModells(ComboBox1.Value, vntValues)
ComboBox2.List = vntValues
'ohne Auswahl
ComboBox2.ListIndex = -1
End Sub
Public Function GetUniqueCarModells(CarBrand As String, Optional Values As Variant) As Long
Dim rngTable As Excel.Range
Set rngTable = GetTableRange()
If rngTable Is Nothing Then
GoTo NoValuesFound
End If
Dim vntResult As Variant
vntResult = WorksheetFunction.Filter(rngTable, Me.Evaluate(rngTable.Columns(1).Address & "=""" & CarBrand & """"))
If IsError(vntResult) Then
GoTo NoValuesFound
End If
'zweite Spalte: "Modell"
vntResult = WorksheetFunction.Index(vntResult, 0, 2)
'2D-Array => 1D-Array
vntResult = WorksheetFunction.Transpose(vntResult)
'nur einzigartige Werte (doppelte werden herausgefiltert)
vntResult = WorksheetFunction.Unique(vntResult, True)
Values = vntResult
GetUniqueCarModells = UBound(Values)
Exit Function
NoValuesFound:
Values = Split(vbNullString)
GetUniqueCarModells = 0
End Function
Public Function GetUniqueCarBrands(Optional Values As Variant) As Long
Dim rngTable As Excel.Range
Set rngTable = GetTableRange()
If rngTable Is Nothing Then
GoTo NoValuesFound
End If
Dim vntResult As Variant
vntResult = WorksheetFunction.Unique(rngTable.Columns(1).Value)
'2D-Array => 1D-Array
vntResult = WorksheetFunction.Transpose(vntResult)
Values = vntResult
GetUniqueCarBrands = UBound(Values)
Exit Function
NoValuesFound:
Values = Split(vbNullString)
GetUniqueCarBrands = 0
End Function
Private Function GetTableRange() As Excel.Range
Dim rngTable As Excel.Range
Set rngTable = Range("A1").CurrentRegion
If rngTable.Rows.Count > 1 Then
Set GetTableRange = rngTable.Offset(1).Resize(rngTable.Rows.Count - 1)
End If
End Function
Grüße
|
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
02.03.2022 14:47:12 |
Eric |
|
|
|
02.03.2022 16:08:18 |
Gast64353 |
|
|
|
03.03.2022 08:29:07 |
Eric |
|
|
|
03.03.2022 09:27:35 |
Gast512 |
|
|
|
03.03.2022 09:34:56 |
Gast19248 |
|
|
|
03.03.2022 12:37:26 |
Gast99240 |
|
|
|
03.03.2022 12:47:43 |
Eric |
|
|
|
03.03.2022 18:49:44 |
ralf_b |
|
|
|
04.03.2022 07:48:28 |
Eric |
|
|
Comboxen Automatisch füllen |
04.03.2022 10:15:35 |
Gast22599 |
|
|
|
07.03.2022 07:42:02 |
Gast93871 |
|
|