Eintrag einer Listbox in Abhängigkeit der Zellauswahl übergeben

[DietmarD]

Hallo zusammen,
ich habe einen Code der immer dieselbe Userform aus einem bestimmten Zellbereich B8:B21 öffnet, was auch funktioniert. 

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngBereich As Range
Set rngBereich = Range("B8:B21")
If Not Intersect(Target, rngBereich) Is Nothing Then
UserForm3.Show
End If
End Sub

Der Zweite Code in der Userform sorgt dafür das der Wert aus der Listbox in eine bestimmte Zelle eingetragen wird. 

Hier nun das Problem, der Wert soll in Abhängigkeit der Ausgewählten Zelle in die Tabelle16 eingetragen werden.

Code:

Private Sub ListBox1_Click()
Tabelle16.Range("B2") = Me.ListBox1.Value
Unload UserForm3
End Sub

Wähle ich die Zelle B8 dann aus soll der Wert aus der Listbox in die Tabelle16 in die Zelle B2   B9 nach  Tabelle16 in die Zelle B3  usw.



B8       Tabelle16 in die Zelle B2
B9       Tabelle16 in die Zelle B3
B10     Tabelle16 in die Zelle B4
B11     Tabelle16 in die Zelle B5
B12     Tabelle16 in die Zelle B6
B13     Tabelle16 in die Zelle B7
B14    usw.
B15
B16
B17
B18 
B19
B20
B21

[Kuwer]

Hallo Dietmar,

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target.Cells(1), Range("B8:B21")) Is Nothing Then
    With UserForm3
      .ListBox1.Tag = Target.Cells(1).Offset(-6).Address(0, 0)
      .Show
    End With
  End If
End Sub

Code:

Private Sub ListBox1_Click()
  Tabelle16.Range(ListBox1.Tag).Value = ListBox1.Value
  Unload Me
End Sub

Gruß Uwe

[DietmarD]

Hallo Uwe,

vielen Dank für deine Antwort funktioniert so wie gefordert, 
aber nach dem Testen hätte ich noch eine Frage.
Ist es möglich, das meine Userform mit der Listbox erst geöffnet wird 
wenn die Eingabe meiner 7-Stelligen Materialnummer erfolgt ist?

[Egon12]

Hallo Dietmar,

falls du es nicht schon selbst herausgefunden hast, ändere es so:

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target.Cells(1), Range("B8:B21")) Is Nothing Then
        If Len(Target.Cells(1)) >= 7 Then
            With UserForm3
                .ListBox1.Tag = Target.Cells(1).Offset(-6).Address(0, 0)
                .Show
            End With
        End If
    End If
End Sub

falls mit der Eingabe direkt nach Beendigung der 7. Stelle die Userform geladen werden soll braucht es noch zusätzlich das:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target.Cells(1), Range("B8:B21")) Is Nothing Then
        If Len(Target.Cells(1)) >= 7 Then
            Target.Cells(1).Select
        End If
    End If
End Sub

Gruß Uwe

[DietmarD]

Hallo Uwe,

vielen Dank für deine wie immer perfekten Lösungen.
Klappt wunderbar. 

[DietmarD]

Hallo Uwe,

ich habe dann doch noch mal eine Frage.
Wenn ich in meiner Eingabetabelle B8:B21 einen Eintrag meiner 7 stelligen Eingabe lösche, ist es dann möglich das dieser auch in meiner Zieltabelle gelöscht wird?

[Kuwer]

Hallo Dietmar,

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target.Cells(1), Range("B8:B21")) Is Nothing Then
        If Len(Target.Cells(1)) >= 7 Then
            Target.Cells(1).Select
        End If
        If Target.Cells(1) = "" Then
            Tabelle16.Range(Target.Cells(1).Offset(-6).Address) = ""
        End If
    End If
End Sub

Gruß Uwe

[DietmarD]

Hallo Uwe,
vielen Dank funktioniert. 
Du bekommst natürlich für deine Unterstützung ein Danke 

[DietmarD]

Hallo Uwe,
ich habe da noch mal eine Frage:

Was muss ich tun um die Ziele zu ändern?

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target.Cells(1), Range("B8:B21")) Is Nothing Then
        If Len(Target.Cells(1)) >= 7 Then
            Target.Cells(1).Select
        End If
        If Target.Cells(1) = "" Then
            Tabelle16.Range(Target.Cells(1).Offset(-6).Address) = ""
        End If
    End If
End Sub

Die Werte kommen aus C das bekomme ich noch hin sollen aber  in der Zieltabelle16  nach B das bekomme ich nicht hin.

Kannst du mir hier noch mal auf die Sprünge helfen?

[Kuwer]

Hallo Dietmar,

Tabelle16.Range(Target.Cells(1).Offset(-6, -1).Address) = ""

Gruß Uwe