15.02.2020, 19:27
Heje Excelfreunde,
würde gerne eine combobox gezielt mit Daten füllen, nicht nach dieser Methode ".ListFillRange = meProjekte" da durch filtern oft
zu große Lücken in den Zeilennummern entstehen. Der Datenbestand kann manchmal mehrere tausend Zeilen sein, daher das einlesen über ein Array.
Die Combobox befindet (muss) sich auf dem Tabellenblatt (1) befinden. Das befüllen der Combox funktioniert so nicht. Wie muss ich das per vba anstellen...
würde gerne eine combobox gezielt mit Daten füllen, nicht nach dieser Methode ".ListFillRange = meProjekte" da durch filtern oft
zu große Lücken in den Zeilennummern entstehen. Der Datenbestand kann manchmal mehrere tausend Zeilen sein, daher das einlesen über ein Array.
Die Combobox befindet (muss) sich auf dem Tabellenblatt (1) befinden. Das befüllen der Combox funktioniert so nicht. Wie muss ich das per vba anstellen...
Code:
Anzahl Kontierungselmente (nach Filter setzen) in ComboBox darstellen
Private Sub Worksheet_Activate()
Dim intArray As Integer
Dim intZ1 As Integer
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
If CStr(Sheets("Konfiguration").Cells(9, 6).Value) = "" Then Exit Sub
'Call meKontDatArryFüllen () Aufruf eigentlich vom Typ Sub
'TEST, ob Array befüllt ist
intArray = meKontDatArryFüllen 'Daher Aufruf als Function
For intZ1 = 0 To intArray
Debug.Print intZ1, meKontDatArray(intZ1)
Next intZ1
With Me.ComboBox1
.List = meKontDatArray()
.ListIndex = 0
End With
Me.Cells(MinRowNumb, 7).Select
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
Anzahl Kontierungselmente (nach Filter setzen / zurücksetzen) in Array laden
Public Function meKontDatArryFüllen()
Dim WSTab2 As Worksheet
Dim intMin As String
Dim intMax As String
Dim intMinZ2 As Integer
Dim intMaxZ2 As Integer
Dim intZ1 As Integer
On Error GoTo Aufraeumen
Set WSTab2 = ThisWorkbook.Worksheets("Konfiguration")
Application.StatusBar = "Combobox wird mit den Daten aus der Konfigurationtabelle befüllt"
With WSTab2
.Unprotect Password:="neutron"
intMin = 13
intMax = WSTab2.Cells(8012, 1).End(xlUp).row
intMinZ2 = .Cells(10, 6).Value
intMaxZ2 = .Cells(11, 6).Value
ReDim meKontDatArray(intMaxZ2 - intMinZ2) '(JK)Array Zaehlt ab 0, ergibt daher ein Elemet mehr als die Differenz intMax-intMin
intMinZ2 = 0
If (intMax - intMin - 1) <= 0 Then GoTo Aufraeumen
For intZ1 = intMin To intMax Step 1
If .Rows(intZ1).Hidden = False Then
meKontDatArray(intMinZ2) = CStr(.Cells(intZ1, 1).Value)
'Debug.Print meKontDatArray(intMinZ2)
intMinZ2 = intMinZ2 + 1
End If
Next intZ1
.Range("$A$1:$B$1").Select
.Protect Password:="neutron", DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFiltering:=True
End With
Aufraeumen:
meKontDatArryFüllen = (intMinZ2 - 1)
Application.StatusBar = ""
Set WSTab2 = Nothing
End Function
Vielen Dank
--Janosch
Excel 2019 (64bit) Win 10 Pro (64bit)
--Janosch
Excel 2019 (64bit) Win 10 Pro (64bit)