AW: Wert aus ComboBox in Tabelle übernehmen
09.07.2014 13:55:03
Rudi
Hallo,
keine Ahnung, was den Fehler verursacht.
Für 5 Spalten (A:E):
Private Sub UserForm_Initialize()
Dim strKey As String, Nummern As Long, Anzahl As Long
Dim strTest, j As Integer
Dim rng As Range
cboNamen.Clear
cboNamen.ColumnCount = 5
ActiveSheet.Unprotect
Set rng = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)).Resize(, 5)
Nummern = rng.Rows.Count
For Anzahl = 1 To Nummern
strTest = Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(rng.Cells(Anzahl, _
1).Resize(, 5))), "|")
If InStr(strKey, strTest) = 0 Then
cboNamen.AddItem rng.Cells(Anzahl, 1)
For j = 2 To 5
cboNamen.List(cboNamen.ListCount - 1, j - 1) = rng.Cells(Anzahl, j)
Next j
strKey = strKey & vbCrLf & strTest
End If
Next Anzahl
lblIndex.Caption = "List.Index = " & cboNamen.ListIndex
lblCount.Caption = "List.Count = " & cboNamen.ListCount
Einfügen = 1
End Sub
Private Sub cboNamen_Change()
Index = frmNummernwahl.cboNamen.ListIndex
lblIndex.Caption = "List.Index = " & cboNamen.ListIndex
If Einfügen = 1 Then
For j = 0 To 4
Range("d29").Offset(, j) = cboNamen.Column(j)
Next
With Range("D29").Resize(, 5).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Application.CutCopyMode = False
Einfügen = 1
End Sub
Als Unikate werden nur DS angesehen, die in allen Feldern unterschiedlich sind.
Gruß
Rudi