jedoch nun bin ich oder meine user auf den geschmack gekommen und es ergibt sich eine zusätzliche Aufgabe.
mit einer Userform in Tabelle 1 greift der code auf Tabelle 2 zu
und liest einen Schlüssel mit einem Wert daneben aus.
Nun besteht zusätzlich die Notwendigkeit auf Tabelle 3 und Tabelle 4 zuzugreifen und habe die entsprechenden listboxen hinzugefügt.
a)es funktioniert auf dem ersten Blick
b)ist in einer der Tabellen kein Wert vorhanden flieg ich raus
auch wenn in der nächsten Tabelle ein Wert vorhanden wäre......
könnte ich umgehen indem ich exit sub rausnehme ....aber ....
c)es gelingt mir nicht listbox3 mit mit drei Spalten einzurichten.
gruss
volker der anfänger im excel
Coding nicht von mir !!!!!!!!!!!!nur das was nicht funktioniert ist von mir *ggg*
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.ListBox1.ColumnCount = 2
UserForm1.ListBox2.ColumnCount = 2
UserForm1.ListBox3.ColumnCount = 3
UserForm1.ListBox1.Clear
UserForm1.ListBox2.Clear
UserForm1.ListBox3.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 ........"
Exit Sub
End If
ReDim MyArray(1 To lngArr, 0 To 1)
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)
End If
Next lfNr
UserForm1.ListBox1.List = MyArray
End With
With Worksheets("Tabelle3")
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 keine Werte in Tabelle 3"
Exit Sub
End If
ReDim MyArray(1 To lngArr, 0 To 1)
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)
End If
Next lfNr
UserForm1.ListBox2.List = MyArray
End With
With Worksheets("Tabelle4")
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 keine Werte in Tabelle 4"
Exit Sub
End If
ReDim MyArray(1 To lngArr, 0 To 1)
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)
End If
Next lfNr
UserForm1.ListBox3.List = MyArray
End With
End Sub
PS:sollte der geistige Vater dieses Codes diese Zeilen lesen,
ersuche ich um kurzen Kontakt auf folgende Mailadresse.....
würde mich gerne bedanken ...
VolkerJoachim@hotmail.com