ListIndex durch Array ersetzen

Hallo :)
ich habe folgendes Problem. Ich habe mir eine Userform Programmiert, welche den ListIndex verwendet. Nun möchte ich allerdings mehr als 10 Indizes abfragen was mit ListIndex nicht möglich ist.
List index ermöglicht es mir die in der Combobox ausgwählten Zeile in den Textboxen anzeigen zu lassen.
ich habe es jetzt schon mit hochzählen über ein Sub versucht wo ich dann auch den Laufzeitfehler 380 bekommen habe und mit Rowsource und da kam leider auch nichts sinnvolles raus.
Habe den Tipp bekommen das ganze über Array zu machen nur weiß ich nicht genau wie ich den Array mit den Indizes fülle.
Code mit Array ist Fett gedruckt in der Codezeile Bzw wie ich die ObjList richtig definiere. denn ich bekomme immer einen Laufzeitfehler
Danke schon einmal für die Antworten.
hier mein Code:


Private Sub ComboBox1_Change()
With ComboBox1
TextBox1.Text = .List(.ListIndex, 0)
TextBox2.Text = .List(.ListIndex, 1)
TextBox3.Text = .List(.ListIndex, 2)
TextBox15.Text = .List(.ListIndex, 3)
TextBox14.Text = .List(.ListIndex, 4)
TextBox7.Text = .List(.ListIndex, 5)
TextBox4.Text = .List(.ListIndex, 6)
TextBox5.Text = .List(.ListIndex, 7)
TextBox8.Text = .List(.ListIndex, 8)
TextBox10.Text = .List(.ListIndex, 9)
TextBox17.Text = .List(.ListIndex, 10)
End With
End Sub
Private Sub UserForm_Initialize()
Dim objCell As Range
Dim strFirsAddress As String
Cells(1, 1).Sort _
Key1:=Cells(2, 20), Order1:=xlAscending, _
Key2:=Cells(2, 17), Order2:=xlAscending, _
key3:=Cells(2, 18), order3:=xlAscending, _
Header:=xlYes
Dim AnzahlGes As Integer
With Box1
.AddItem "1 - Grün"
.AddItem "2 - Gelb"
.AddItem "3 - Rot"
.AddItem "4 - Weiß"
End With
With Box2
.AddItem "Name2"
.AddItem "Name1"
.AddItem "Nicht Relevant"
End With
AnzahlLeer = AnzahlZeilen(Worksheets("Tabelle16"), "S:S")
AnzahlGes = AnzahlZeilen(Worksheets("Tabelle16"), "A:A")
AnzahlLeer = AnzahlGes - AnzahlLeer
Label17.Caption = "Arbeitsvorrat " & AnzahlLeer
Set mobjCollection = New Collection
With Worksheets("Tabelle16")
For Each objCell In .Range(.Cells(2, 19), .Cells(.Rows.Count, 19))
If Not IsEmpty(objCell.Value) And IsEmpty(objCell.Offset(0, 3)) Then
TextBox1.Text = objCell.Offset(0, -18).Value
TextBox2.Text = objCell.Offset(0, -17).Value
TextBox3.Text = objCell.Offset(0, 0).Value
TextBox15.Text = objCell.Offset(0, -12).Value
TextBox14.Text = objCell.Offset(0, 2).Value
TextBox7.Text = objCell.Offset(0, -4).Value
TextBox4.Text = objCell.Offset(0, -8).Value
TextBox5.Text = objCell.Offset(0, -1).Value
TextBox8.Text = objCell.Offset(0, -15).Value
TextBox10.Text = objCell.Offset(0, -16).Value
TextBox17.Text = objCell.Offset(0, 4).Value
Box1.Text = objCell.Offset(0, 1).Value
mlngRow = objCell.Row
Call mobjCollection.Add(Item:=mlngRow)
Exit For
End If
Next
End With
With ComboBox1
.ColumnCount = 25
.ColumnWidths = "80;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0" 'Soviel 0en wie abgefragte Spalten
End With
Set objCell = Worksheets("Tabelle16").Columns(20).Find(What:="4 - Weiß", After:=Worksheets("Tabelle16").Cells(Worksheets("Tabelle16").Rows.Count, 20), _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True) 'hier auf Spalte 20 bezogen
If Not objCell Is Nothing Then 'hier auf Spalte 20 bezogen
strFirsAddress = objCell.Address
Do
With ComboBox1
.AddItem objCell.Offset(0, -19).Value
.List(.ListCount - 1, 1) = objCell.Offset(0, -18).Value
.List(.ListCount - 1, 2) = objCell.Offset(0, 0).Value
.List(.ListCount - 1, 3) = objCell.Offset(0, -13).Value
.List(.ListCount - 1, 4) = objCell.Offset(0, 1).Value
.List(.ListCount - 1, 5) = objCell.Offset(0, -5).Value
.List(.ListCount - 1, 6) = objCell.Offset(0, -9).Value
.List(.ListCount - 1, 7) = objCell.Offset(0, -2).Value
.List(.ListCount - 1, 8) = objCell.Offset(0, -16).Value
.List(.ListCount - 1, 9) = objCell.Offset(0, -17).Value
.List(.ListCount - 1, 10) = objCell.Offset(0, 3).Value
End With
Set objCell = Worksheets("Tabelle16").Columns(20).FindNext(After:=objCell)
Loop Until objCell.Address = strFirsAddress
Set objCell = Nothing
End If
End Sub

Code mit Array:


Private Sub UserForm_Initialize()
Dim objCell As Range
Dim strFirstAddress As String
Dim objList As Object
Set objList = CreateObject("scripting.dictionary")
objList.Items "1", "Textbox1.Text"
objList.Items "2", "Textbox2.Text"
objList.Items "3", "Textbox3.Text"
objList.Items "4", "Textbox15.Text"
objList.Items "5", "Textbox14.Text"
objList.Items "6", "Textbox7.Text"
objList.Items "7", "Textbox4.Text"
objList.Items "8", "Textbox5.Text"
objList.Items "9", "Textbox8.Text"
objList.Items "10", "Textbox10.Text"
objList.Items "11", "Textbox17.Text"
Cells(1, 1).Sort _
Key1:=Cells(2, 20), Order1:=xlAscending, _
key2:=Cells(2, 17), order2:=xlAscending, _
key3:=Cells(2, 18), order3:=xlAscending, _
Header:=xlYes
Dim AnzahlGes As Integer
With Box1
.AddItem "1 - Grün"
.AddItem "2 - Gelb"
.AddItem "3 - Rot"
.AddItem "4 - Weiß"
End With
With Box2
.AddItem "Name1"
.AddItem "Name2"
.AddItem "Nicht Relevant"
End With
AnzahlLeer = AnzahlZeilen(Worksheets("Tabelle16"), "S:S")
AnzahlGes = AnzahlZeilen(Worksheets("Tabelle16"), "A:A")
AnzahlLeer = AnzahlGes - AnzahlLeer
Label17.Caption = "Arbeitsvorrat " & AnzahlLeer
Set mobjCollection = New Collection
With Worksheets("Tabelle16")
For Each objCell In .Range(.Cells(2, 19), .Cells(.Rows.Count, 19))
If Not IsEmpty(objCell.Value) And IsEmpty(objCell.Offset(0, 3)) Then
TextBox1.Text = objCell.Offset(0, -18).Value
TextBox2.Text = objCell.Offset(0, -17).Value
TextBox3.Text = objCell.Offset(0, 1).Value
TextBox15.Text = objCell.Offset(0, -12).Value
TextBox14.Text = objCell.Offset(0, 2).Value
TextBox7.Text = objCell.Offset(0, -4).Value
TextBox4.Text = objCell.Offset(0, -8).Value
TextBox5.Text = objCell.Offset(0, -1).Value
TextBox8.Text = objCell.Offset(0, -15).Value
TextBox10.Text = objCell.Offset(0, -16).Value
TextBox17.Text = objCell.Offset(0, 4).Value
Box1.Text = objCell.Offset(0, 1).Value
mlngRow = objCell.Row
Call mobjCollection.Add(Item:=mlngRow)
Exit For
End If
Next
End With
With ComboBox1
.ColumnCount = 25
.ColumnWidths = "80;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0" 'Soviel 0en wie abgefragte Spalten
End With
Set objCell = Worksheets("Tabelle16").Columns(20).Find(What:="4 - Weiß", After:=Worksheets("Tabelle16").Cells(Worksheets("Tabelle16").Rows.Count, 20), _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True) 'hier auf Spalte 20 bezogen
If Not objCell Is Nothing Then 'hier auf Spalte 20 bezogen
strFirstAddress = objCell.Address
Do
With ComboBox1
objList(objCell.Address) = Array(objCell.Offset(0, -19).Value, _
objCell.Offset(0, -18).Value, objCell.Offset(0, 0).Value, _
objCell.Offset(0, -13).Value, objCell.Offset(0, 1).Value, _
objCell.Offset(0, -5).Value, objCell.Offset(0, -9).Value, _
objCell.Offset(0, -2).Value, objCell.Offset(0, -16).Value, _
objCell.Offset(0, -17).Value, objCell.Offset(0, 3).Value)
End With
Set objCell = Worksheets("Tabelle16").Columns(20).FindNext(After:=objCell)
Loop Until objCell.Address = strFirstAddress
Set objCell = Nothing
End If
If objList.Count Then
ComboBox1.List = Application.Transpose(Application.Transpose(objList.Items))
End If
End Sub

hier ist noch eine Beispieldatei:
https://www.herber.de/bbs/user/147789.xlsm

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

If Not objCell Is Nothing Then 'hier auf Spalte 20 bezogen strFirsAddress = objCell.Address Do With ComboBox1 .AddItem objCell.Offset(0, -19).Value .List(.ListCount - 1, 1) = objCell.row End With Set objCell = Worksheets("Tabelle16").Columns(20).FindNext(After:=objCell) Loop Until objCell.Address = strFirsAddress Set objCell = Nothing End If

Private Sub ComboBox1_Change() With ComboBox1 TextBox1.Text = Sheets("Tabelle16").Cells(.List(ListIndex, 0), 1) TextBox2.Text = Sheets("Tabelle16").Cells(.List(ListIndex, 1), 2) TextBox3.Text = Sheets("Tabelle16").Cells(.List(ListIndex, 2), 20) TextBox15.Text = Sheets("Tabelle16").Cells(.List(ListIndex, 3), 7) TextBox14.Text = Sheets("Tabelle16").Cells(.List(ListIndex, 4), 21) TextBox7.Text = Sheets("Tabelle16").Cells(.List(ListIndex, 5), 15) TextBox4.Text = Sheets("Tabelle16").Cells(.List(ListIndex, 6), 11) TextBox5.Text = Sheets("Tabelle16").Cells(.List(ListIndex, 7), 18) TextBox8.Text = Sheets("Tabelle16").Cells(.List(ListIndex, 8), 4) TextBox10.Text = Sheets("Tabelle16").Cells(.List(ListIndex, 9), 3) TextBox17.Text = Sheets("Tabelle16").Cells(.List(ListIndex, 10), 23) End With End Sub

.AddItem objCell.Offset(0, -19).Value .List(.ListCount - 1, 1) = objCell.Row .List(.ListCount - 1, 2) = objCell.Row .List(.ListCount - 1, 3) = objCell.Row .List(.ListCount - 1, 4) = objCell.Row .List(.ListCount - 1, 5) = objCell.Row .List(.ListCount - 1, 6) = objCell.Row .List(.ListCount - 1, 7) = objCell.Row .List(.ListCount - 1, 8) = objCell.Row .List(.ListCount - 1, 9) = objCell.Row .List(.ListCount - 1, 10) = objCell.Row

Hi Daniel (mit ca 29.000 Einträgen!),
komm doch mal wieder runter und reagier, wie in dem Beitrag, auf den ich gerade antworte, nicht so vorwurfsvoll.
- ich bin sicher, als du mit VBA-Programmieren begonnen hast, hast du, wie jeder Anfänger, auch erst mal "wie der Ochse vorm Tor gestanden"
- ich bin sicher, zu Beginn hast auch du nicht gewusst, dass .ListIndex eine Eigenschaft von List- bzw ComboBoxen ist
- ich bin sicher, am Anfang deiner "VBA-Karriere" hast auch du erst mal all die Zusammenhänge nicht verstanden, sondern hast dich mit vielen, vielen immer-wieder-Tests an die Lösung(en) herangearbeitet
Und wenn du bzgl meiner Aufzählungen das Gegenteil behauptest, dann...glaube ich dir kein Wort :-)
Ha! Vielleicht doch!
Ausnahme: du hattest vor VBA schon andere Programmierkenntnisse, die du gewinnbringend in VBA einsetzen konntest
Wie dem auch sei: Daniel (mit bisher nur ca 130 Beiträgen) steht noch ganz am Anfang mit seinen Kenntnissen und wird bestimmt immer wieder mal Fragen stellen, bei denen wir denken könnten "Hmm? Wieso weiß er das nicht? Wieso kann er sich das nicht selbst beantworten? Is doch toootal einfach!"
Hehe...falls du gerade daran denkst...spar dir die Mühe, auf herber.de nach Beiträgen von mir zu suchen, in denen ich teilweise bestimmt noch schlimmer, man könnte es fast als arrogant bezeichnen, reagiert habe.
Ja, auch ohne "Beweise" von dir stimmt all das, was mit "Hehe..." beginnt.
Und ich finde mittlerweile, dass war krass bescheuert von mir!
Deswegen versuche ich gerade, mein Verhalten hier bei herber.de zu mäßigen, und nur noch kompetent aber nicht mehr mit erhobenem Zeigefinger zu antworten.
Lasst uns doch alle "ein Team" sein, und lasst uns Antworter nicht schuld daran sein, wenn die Fragenden den Spaß an Excel/VBA verlieren könnten.
Ciao
Thorsten

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

ListIndex durch Array ersetzen

12 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)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread