AW: Dropdown in Userform variabel Füllen
22.07.2021 08:47:31
Daniel
Ich verstehe nur nicht warum er mir das eben nicht anzeigt... in der beispieldatei ist es ja passend
Option Explicit
Private mlngrow As Long
Private mobjCollection As Collection
Private Sub Label16_Click()
End Sub
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)
End With
End Sub
Private Sub UserForm_Initialize()
Dim objCell As Range
Dim strFirsAddress As String
With Box1
.AddItem "Grün"
.AddItem "Gelb"
.AddItem "Rot"
.AddItem "Weiß"
End With
Set mobjCollection = New Collection
With Worksheets("Tabelle16")
With .Columns(19)
For Each objCell In .Cells
If IsEmpty(objCell.Value) 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
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 = 21
.ColumnWidths = "80;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0"
End With
Set objCell = .Columns(20).Find(What:="Weiß", After:=.Cells(.Rows.Count, 20), _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
If Not objCell Is Nothing Then
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, 1).Value
.List(.ListCount - 1, 3) = objCell.Offset(0, -12).Value
End With
Set objCell = .Columns(20).FindNext(After:=objCell)
Loop Until objCell.Address = strFirsAddress
Set objCell = Nothing
End If
End With
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Set mobjCollection = Nothing
End Sub
'Weiter Button Nächste Relevante
Private Sub CommandButton1_Click()
Dim lngRow As Long
With Worksheets("Tabelle16")
.Cells(mlngrow, 19).Value = Now
.Cells(mlngrow, 20).Value = Bearbeiter.Box1
For lngRow = mlngrow + 1 To .Rows.Count
If IsEmpty(.Cells(lngRow, 19).Value) Then
TextBox1.Text = .Cells(lngRow, 1).Value
TextBox2.Text = .Cells(lngRow, 2).Value
TextBox3.Text = .Cells(lngRow, 20).Value
TextBox15.Text = .Cells(lngRow, 7).Value
mlngrow = lngRow
Call mobjCollection.Add(Item:=mlngrow)
Exit For
End If
Next
End With
End Sub
Private Sub CommandButton4_Click()
Dim lngIndex As Long
With mobjCollection
For lngIndex = .Count To 1 Step -1
If .Item(lngIndex)
