Wert aus ComboBox in Tabelle übernehmen

Forumthread: Wert aus ComboBox in Tabelle übernehmen

09.07.2014 09:53:09

reiner

hallo Leute,
https://www.herber.de/bbs/user/91423.xlsm
die im Beispiel enthaltenen Daten werden nach Betätigen der Schaltfläche in die ComboBox ohne doppelte Einträge eingelesen.
Bei Anwahl eines Eintrags der ComboBox wird dieser in den gelb hinterlegten Zellbereich eingefügt.
Dabei fällt auf, das nicht der dem gewählten Eintrag entsprechende Wert (aus der Tabelle) eingefügt wird, weil der Listindex der cbo in der Regel nicht der Zeilennummer entspricht.
Hat jemand eine Idee wie sich das beschriebene Problem verhindern lässt?
mfg
reiner

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Wert aus ComboBox in Tabelle übernehmen

09.07.2014 10:49:06

Rudi

Hallo,
warum nimmst du keine 2-spaltige ComboBox?

Private Sub UserForm_Initialize()
Dim mText As String, Nummern As Long, Anzahl As Long
Dim strTest As String
Dim rng As Range
cboNamen.Clear
cboNamen.ColumnCount = 2
ActiveSheet.Unprotect
Set rng = Range(Cells(1, 1), Cells(14, 2))
Nummern = rng.Rows.Count
For Anzahl = 1 To Nummern
mText = rng.Cells(Anzahl, 1) _
& "|" _
& rng.Cells(Anzahl, 2)
If InStr(strTest, mText) = 0 Then
cboNamen.AddItem rng.Cells(Anzahl, 1)
cboNamen.List(cboNamen.ListCount - 1, 1) = rng.Cells(Anzahl, 2)
strTest = strTest & vbCrLf & mText
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
Range("d29") = cboNamen.Column(0)
Range("e29") = cboNamen.Column(1)
With Range("D29:E29").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Application.CutCopyMode = False
Einfügen = 1
End Sub

Gruß
Rudi

AW: Wert aus ComboBox in Tabelle übernehmen

09.07.2014 13:29:47

reiner

hallo Rudi,
dein Vorschlag funktioniert wunderbar;
ich habe lediglich eine Beispieldatei hochgeladen da die Originaldatei viel zu groß wäre und interne Daten aus einem Unternehmen enthält.
Es geht in der Originaldatei um 5 Spalten ( H,I,J,K,L) mit Telefonnummern, bestehend aus:
Cbc-Nummer, Mobilfunknummer-Vorwahl, Auslands-Vorwahl, Ortsnetz-Vorwahl und Teilnehmernummer.
Im Beispiel habe ich mich auf Ortsnetz-Vorwahl und Teilnehmernummer beschränkt.
Wie müsste dein Vorschlag erweitert werden damit 5 Spalten und mehr als 1000 Zeilen in die cbo eingelesen werden
Bei der Abarbeitung des Programmcodes:

Set rng = Range(Cells(1, 1), Cells(14, 2))

erscheint eine Fehlermeldung Laufzeitfehler 424 (Objekt erforderlich)
wenn ich die Schaltfläche "Debuggen" betätige erfolgt ein Sprung in ein anderes Modul zu frmNummernwahl.Show
hast du eine Idee wie dieser Sprung verhindert werden kann?
mfg
Reiner

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

AW: Wert aus ComboBox in Tabelle übernehmen

09.07.2014 16:34:39

reiner

läuft bestens,
danke Rudi

Beliebteste Forumthreads (12 Monate)

Wert aus ComboBox in Tabelle übernehmen

Forumthread: Wert aus ComboBox in Tabelle übernehmen

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Wert aus ComboBox in Tabelle übernehmen

Forumthread: Wert aus ComboBox in Tabelle übernehmen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread