Datengültigkeit

Hallo,
bin neu hier und hoffe alles richtig zu machen.
Ich habe für eine Zelle die Datengültigkeit eingerichtet, und habe jetzt ein Problem mit der Liste dafür.
Die liste kommt aus Spalte G aus der zweiten Tabelle, das wäre auch kein Problem, wenn da nicht der Aufbau der Spalte wäre.
Zum einen gibt es Leerzeilen, dann ist es eine Namensliste, der Namen kann aber aus Titel, Vornamen, Nachnamen bestehen aber auch nur aus Vornamen und Nachnamen.
zB.
Peter Klein
Dr.Werner Gross
Peter-Paul Mever
Karl Schmidt-Meyer
Dr.Hans-Peter Ludwig-Müller
Die Auswahlliste sollte jetzt ohne Leerzeilen und sortiert nach Nachnamen erscheinen, wenn ich aber ausgewählt habe, soll der Name in der Zelle wieder in der richtigen Reihenfolge stehen.
Man sagte mir das es hier eine VBAlösung gebe,ich konnte aber nichts finden. Das liegt aber vielleicht daran das ich außer den Editor sonst keine Ahnung von VBA habe und vielleicht falsch gesucht habe.
Könnt ihr mir bitte helfen.
Viele Grüsse Peter

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo Err_Handler If Target.Address(0, 0) = "E2" Then Application.EnableEvents = False Target = WorksheetFunction.VLookup(Target, Range("A:B"), 2, 0) End If Err_Handler: Application.EnableEvents = True End Sub

Hallo Peter,
mit dem Zellendropdown ist da nichts zumachen, die zeigt immer nur 8 Einträge an.
Da ja in den Tabellen nichts verändert werden soll,wäre eine Userform mit einer Listbox das richtige.
Kannst ja erstmal in meiner Beispieldatei testen,ob du es hinbekommst.
In den VB-Editor gehen, Einfügen/Userform
Jetzt Rechtsklick auf die Userform/Eigenschaften
Height 520
Width 170
Eigenschaftenfenster schließen,auf die Userform klicken
das kleine Fenster Werkzeugsammlung erscheint.dort mit der Maus über die Symbole gehen bis Listenfeld erscheint(sollte ganz oben rechts sein). Darauf klicken und dann in die Userform einfügen. Das Listenfeld so ziehen,das die ganze Userform ausgefüllt ist.
Jetzt Rechtsklick auf das Listenfeld/Eigenschaften
Dort bei Font die Schriftart,Schriftgröße,Schriftschnitt wählen. (10,Fett,wäre ein Vorschlag)
Eigenschaftenfenster schließen, Rechtsklick im linken Fenster auf die Userform/Code anzeigen.
dort dann auf der rechten Seite folgenden Code einfügen

Private Sub ListBox1_Click()
ActiveSheet.Range("D3").Value = ListBox1.Value
Unload UserForm1
End Sub

nun mußt du in "Diese Arbeitsmappe" (das kennst du ja schon)
dort gibt es zwei Codes

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

diese,aber nur diese komplett löschen.
Dann fügst du dort folgenden Code ein

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim x As String
If ActiveSheet.Name <> "Testformular" Then Exit Sub
If Target.Address(0, 0) = "B3" Or Target.Address(0, 0) = "D3" Then
x = VNwechsel(Target.Value)
Application.EnableEvents = False
Target.Value = x
Application.EnableEvents = True
End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.Name <> "Testformular" Then Exit Sub
If Target.Address(0, 0) = "B3" Then
Dim arr As Variant
arr = DDliste(Sheets("Prüfdaten").Range("PUR"))
With Range("B3").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=Join(arr, ",")
.InCellDropdown = True
End With
End If
If Target.Address(0, 0) = "D3" Then
arr = DDliste(Sheets("Prüfdaten").Range("PUR"))
With Range("D3").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=Join(arr, ",")
.InCellDropdown = False
End With
UserForm1.ListBox1.List = arr
UserForm1.Left = ActiveCell.Left + (ActiveCell.Width + 20)
UserForm1.Show
End If
End Sub

Den VB-Editor nun schließen.
Wenn du nun in Testformular in die Zelle D3 klickst, sollte die Userform erscheinen, bei Klick auf einen Namen in der Liste wird dieser in D3 eingetragen und die Userform geschlossen.
Gruß Ewald

Sub TVN_TO_NVT() 'Titel/Vorname/Nachname nach Nachname/Vorname/Titel Dim anzpoint Dim mytit Dim myvor Dim mynach Dim Ergebnis Dim a Dim b a = ActiveCell.Value anzpoint = InStrRev(a, ".") If anzpoint = 0 Then mytit = "" b = a Else mytit = Left(a, InStrRev(a, ".")) b = Mid(a, InStrRev(a, ".") + 1, Len(a)) End If myvor = Left(b, InStrRev(b, " ")) mynach = Right(b, Len(b) - InStrRev(b, " ")) If anzpoint = 0 Then Ergebnis = mynach & " " & myvor Else Ergebnis = mynach & " " & myvor & " " & mytit End If MsgBox Ergebnis End Sub Sub NVT_TO_TVN() 'Nachname/Vorname/Titel nach Titel/Vorname/Nachname Dim anzpoint Dim mytit Dim myvor Dim mynach Dim Ergebnis Dim a Dim b a = ActiveCell.Value anzpoint = InStrRev(a, ".") If anzpoint = Len(a) Then mytit = Right(a, Len(a) - InStrRev(a, " ")) b = Left(a, Len(a) - Len(mytit)) mynach = Left(b, InStr(b, " ")) myvor = Mid(b, InStr(b, " ") + 1, Len(b) - (InStr(b, " ") + 1)) Ergebnis = mytit & " " & myvor & " " & mynach End If If anzpoint = 0 Then mynach = Left(a, InStrRev(a, " ")) myvor = Right(a, Len(a) - InStrRev(a, " ")) Ergebnis = myvor & " " & mynach End If MsgBox Ergebnis End Sub

Beliebteste Forumthreads (12 Monate)

18 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread