|
Hallo Ivy,
warum einfach, wenn's auch umständlich geht? :-)
Dein "Fehler" besteht lediglich darin dass du auf den Play-Butto drückst. Dieser startet normalerweise ein Makro. Bei meinem Code für Modul "Tabelle1" handelt es sich aber um ein Ereignis, welches automatisch ausgeführt wird, sobald du eine Eingabe in eine beliebige Zelle von Tabelle1 vornimmst. Ein benutzerabhängiges Starteten des Codes ist somit überflüssig.
Ich bin jedoch die ganze Zeit davon ausgegangen, dass in Tabelle 2 Spalte A z.B. Projekt 1 steht und in Tabelle2 Spalte B die Aufgabe. Falls also die Aufgabe erst in Spalte C steht, musst du meinen Code entsprechend anpassen.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Target = Application.WorksheetFunction.VLookup(Target, Sheets("Tabelle2").Range("A:C"), 3, 0)
End Sub
Von der Verwendung des Dictionary Objekts würde ich dir hingegen abraten. Zu kompliziert für einen Anfänger wie dich (ohne dir zu Nahe treten zu wollen) und obendrein völlig überflüssig. Ohne zu wissen, was bei dir wo steht, kann ich das leider auch nicht für dich anpassen. Nun davon ausgehend, dass die Beschreibung in Spalte C steht kann ich also nur raten.
Sub Werte_Zuordnen()
Dim dic As Object, wsSource As Worksheet, wsTarget As Worksheet, rngDataStart As Range, rngDataEnd As Range, rngTargetStart As Range, rngTargetEnd As Range, cell As Range
'Dictionary Object das die Zuordnung der Daten der ersten Tabelle enthält
Set dic = CreateObject("Scripting.Dictionary")
'Worksheets referenzieren
Set wsSource = Worksheets(2)
Set wsTarget = Worksheets(1)
'Referenzbereich der ersten Tabelle festlegen
Set rngDataStart = wsSource.Range("A1")
Set rngDataEnd = rngDataStart.End(xlDown)
'Zielbereich der zweiten Tabelle
Set rngTarget = wsTarget.Range("A1:D50")
'Dictionary mit den Werten der ersten Tabelle füllen
For Each cell In wsSource.Range(rngDataStart, rngDataEnd)
dic.Add cell.Value, cell.Offset(0, 2).Value
Next
'Zieltabelle durchgehen und Werte zuordnen
For Each cell In rngTarget
' Wenn Wert der Zelle nicht leer ist und der Wert in der Zuordnungstabelle vorhanden ist dann schreibe den Wert in die Zelle daneben
If cell.Value <> "" And dic.Exists(cell.Value) Then
cell.Offset(0, 1).Value = dic.Item(cell.Value)
End If
Next
End Sub
Die von die genannte Problemzeile war übrigens überflüssig.
Gruß Mr. K.
|