da ich fremden code zusammenfüge und nicht immer richtig lese...
oder auch die fragen nicht exakt genug stelle..
habe ich jetzt eine spitzen anwendung die hervoragend funktioniert (liebe Hilfe von L.Vira)jedoch muss ich jetzt
den Code soweit abändern ....das beim change ..ereignis
der Userform1 aus tabelle 1 nicht der wert aus spalte 1 ausgelesen wird sondern aus spalte 5...und ich bring das nicht hin ....
also ich stehe in tabelle 1 stelle mich in spalte 5 und nun geht der liebe *g* code in tabelle 2 und sieht nach ob eine oder mehrere idente lfnr ....vorhanden sind und gibt sie in einer listbox in userform 1 zurück...
wer sich die mühe machen will ....kann...möchte...
bitte danke
der Code:
Option Explicit
Public Zeile As Long
Sub UpdateUF()
Dim lfNr As Object
Dim lngArr As Long
UserForm1.Label1 = Cells(Zeile, 1)
UserForm1.Label2 = Cells(Zeile, 2)
UserForm1.Label3 = Cells(Zeile, 3)
UserForm1.Label4 = Cells(Zeile, 4)
UserForm1.Label5 = Cells(Zeile, 5)
UserForm1.Label6 = Cells(Zeile, 6)
UserForm1.Label7 = Cells(Zeile, 7)
UserForm1.Label8 = Cells(Zeile, 8)
UserForm1.Label9 = Cells(Zeile, 9)
UserForm1.Label10 = Cells(Zeile, 10)
UserForm1.Label11 = Cells(Zeile, 11)
UserForm1.Label12 = Cells(Zeile, 12)
UserForm1.Label13 = Cells(Zeile, 13)
UserForm1.ListBox1.ColumnCount = 4
UserForm1.ListBox1.Clear
With Worksheets("Tabelle2")
lngArr = 0
For Each lfNr In .Range("A1:A" & .Range("A65536").End(xlUp).Row)
If lfNr = Cells(Zeile, 1) Then lngArr = lngArr + 1
Next lfNr
If lngArr = 0 Then
'MsgBox "Es gibt keinen Eintrag in Tabelle2"
Else
ReDim MyArray(1 To lngArr, 0 To 3)
lngArr = 0
For Each lfNr In .Range("A1:A" & .Range("A65536").End(xlUp).Row)
If lfNr = Cells(Zeile, 1) Then
lngArr = lngArr + 1
MyArray(lngArr, 0) = .Cells(lfNr.Row, 2)
MyArray(lngArr, 1) = .Cells(lfNr.Row, 3)
MyArray(lngArr, 2) = .Cells(lfNr.Row, 4)
MyArray(lngArr, 3) = .Cells(lfNr.Row, 5)
End If
Next lfNr
UserForm1.ListBox1.List = MyArray
End If
End With