|
Also bei mir geht da leider das Makro Fenster auf wenn ich auf den Play Pfeil drücke :(
Wenn ich über Makro erstellen das versuche nimmt er das leider auch nicht . Er setzt dann Sub ... davor und meldet "Außerhalb einer Prozedur ungültig".
Entferne ich das Sub wieder, so erscheint wieder das leere Makro Fenster.
Wo ist mein Fehler?
Danke aber schonmal für die Antwort!
Ich habe inzwischen noch einen zweiten Code mit Hilfe von Google zusammen gebastelt. Dieser scheint die Daten tatsächlich auszulesen, allerdings spuckt er mir
statt des gewollten Value aus Tabelle 2 das aus was ich hinter Item eingetragen hab. Ich poste es mal hier ran, evtl. kannst du mir sagen wie ich das Item:= ("Tabelle2, C") ändern muss dass er mir nicht das, sondern den Wert aus der Tabelle ausspuckt.
Vielen lieben Dank!
Option Explicit
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")
dic.Add Key:="Projekt1", Item:="Tabelle2, C" (<<<<- Hier spuckt er statt des Eintrages "Rutsche bauen" nach wie vor "Tabelle2, C" aus
'Worksheets referenzieren
Set wsSource = Worksheets(2)
Set wsTarget = Worksheets(1)
'Referenzbereich der ersten Tabelle festlegen
Set rngDataStart = wsSource.Range("C1")
Set rngDataEnd = rngDataStart.End(xlDown)
'Zielbereich der zweiten Tabelle
Set rngTargetStart = wsTarget.Range("A1:D2")
Set rngTargetEnd = wsTarget.Cells(Rows.Count, 1).End(xlUp)
'Dictionary mit den Werten der ersten Tabelle füllen
For Each cell In wsSource.Range(rngDataStart, rngDataEnd)
dic.Add cell.Value, cell.Offset(0, 1).Value
Next
'Zieltabelle durchgehen und Werte zuordnen
For Each cell In wsTarget.Range(rngTargetStart, rngTargetEnd)
' 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
|