ich habe ein Problem, und zwar ich versuche ein Dropdown automatisch zu befüllen.
Ich bekomme die Fehlermeldung im Dickgedruckten teil: Laufzeitfehler '13': Typen unverträglich.
hier der code:
Option Explicit
Dim AnzahlLeer As Integer
Private mlngrow As Long
Private mobjCollection As Collection
Function AnzahlZeilen(Blatt As Worksheet, Spalte As String) As Long
AnzahlZeilen = WorksheetFunction.CountA(Blatt.Range(Spalte))
End Function
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)
TextBox14.Text = .List(.ListIndex, 4)
TextBox7.Text = .List(.ListIndex, 5)
End With
End Sub
Private Sub UserForm_Initialize()
Dim objCell As Range
Dim strFirsAddress As String
Dim AnzahlGes As Integer
With Box1
.AddItem "Grün"
.AddItem "Gelb"
.AddItem "Rot"
.AddItem "Weiß"
End With
With Box2
.AddItem "Max Mustermann"
.AddItem "Ulrike Musterfrau"
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 Not 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
Box1.Text = objCell.Offset(0, 1).Value
mlngrow = objCell.Row
Call mobjCollection.Add(Item:=mlngrow)
Exit For
End If
Next
End With
End Sub
Private Sub CommandButton10_Click()
Dim objCell As Range
Dim strFirsAddress As String
ComboBox1.Clear
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" 'Soviel 0en wie abgefragte Spalten
End With
Set objCell = Worksheets("Tabelle16").Columns(24).Find(What:=Box2.Value, After:=Worksheets("Tabelle16").Cells(Worksheets("Tabelle16").Rows.Count, 20), _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True) 'hier auf Spalte 24 bezogen
If Not objCell Is Nothing Then
strFirsAddress = objCell.Address
Do
With ComboBox1
.AddItem objCell.Offset(0, -23).Value
.List(.ListCount - 1, 1) = objCell.Offset(0, -22).Value
.List(.ListCount - 1, 2) = objCell.Offset(0, -4).Value
.List(.ListCount - 1, 3) = objCell.Offset(0, -17).Value
.List(.ListCount - 1, 4) = objCell.Offset(0, -3).Value
.List(.ListCount - 1, 5) = objCell.Offset(0, -9).Value
End With
Set objCell = Worksheets("Tabelle16").Columns(20).FindNext(After:=objCell)
Loop Until objCell.Address = strFirsAddress
Set objCell = Nothing
End If
End Sub
und hier noch eine Beispiel Datei:https://www.herber.de/bbs/user/147478.xlsm