AW: Tabellen verknüpfen
02.09.2006 23:36:19
Trostlooser
Sorry, musste zwischendurch noch kurz was erledigen...
Nach der Benennung der Bereiche gehst Du nun in den VBA-Editor mit Alt+F11. Im linken Bereich solltest Du eine Liste mit Objekten sehen, die an den Windows-Explorer erinnert. Doppel-Klicke die auf Tabelle1. Ein Fenster sollte sich nun öffnen. Im oberen Bereich des Fensters findest Du zwei ausklappbare Listen. In der linken wählst Du nun "Worksheet" aus, währen Du dann in der rechten "Change" auswählst. Es sollte Dir gleich ein Prozedur-Rumpf erstellt werden, also
Private Sub Worksheet_Change(ByVal Target As Range)
End Sub
Diese Prozedur wird immer dann ausgeführt, wenn du den inhalt einer Zelle auf Tabelle1 änderst. Gib folgenden Text ein:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich_von As Range, Bereich_nach As Range
Dim i As Integer
Set Bereich_von = ThisWorkbook.Names("Daten1").RefersToRange
Set Bereich_nach = ThisWorkbook.Names("Daten2").RefersToRange
If (Bereich_von.Columns.Count <> Bereich_nach.Columns.Count) Or (Bereich_von.Rows.Count <> Bereich_nach.Rows.Count) Then
MsgBox "Leider sind die Dimensionen nicht gleich, evtl. Zeilen und/oder Reihen eingefügt/entfernt?"
'Kann umgangen werden, wenn von vorneherein der Datenbereich etwas größer mit weiteren leeren Zeilen gewählt wird!!!
Exit Sub
End If
Bereich_von.Copy Bereich_nach
Bereich_nach.Sort Key1:=Bereich_nach.Columns(2), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Das gleiche nun für Tabelle3
Set Bereich_nach = ThisWorkbook.Names("Daten3").RefersToRange
If (Bereich_von.Columns.Count <> Bereich_nach.Columns.Count) Or (Bereich_von.Rows.Count <> Bereich_nach.Rows.Count) Then
MsgBox "Leider sind die Dimensionen nicht gleich, evtl. Zeilen und/oder Reihen eingefügt entfernt?"
Exit Sub
End If
Bereich_von.Copy Bereich_nach
Bereich_nach.Sort Key1:=Bereich_nach.Columns(3), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Am Schluss noch Tabelle1 sortieren
Bereich_von.Sort Key1:=Bereich_von.Columns(1), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
Hinweise:
Wenn Du deine Bereiche anders genannt hast, dann musst Du statt "Daten1" Deinen Namen verwenden.
Weiterhin musst Du die Sortierung anpassen: Key1:=Bereich_nach.Columns(X) wobei X die Spalte innerhalb der Tabelle ist nach der Du soriteren willst, z.B. dritte Spalte der Tabelle, also: ...Columns(3).
Eventuell musst Du noch Header:= verändern, wenn die Sortierung nicht richtig funktioniert. Kommt darauf an, ob Dein Bereich die Spaltenkopfbezeichnung mit einschließt oder nicht.
Wie bereits im Quellcode erwähnt müssen die Bereiche alle die gleiche Dimension haben. Ansonsten muss man per VBA die Bereiche durch Einfügen oder Löschen von Zeilen und Spalten angleichen was recht aufwendig ist. Besser ist es wenn man die Bereiche gleich etwas größer wählt, also bei der Namensvergebung den ausgewählten Bereich nach unten hin etwas ausdehnt und einige leere Zeilen mit erfasst, wo man dann neue Daten einträgt (die ja danach ohnehin an die richitge Stelle sortiert werden). Schließlich kannst Du den gesamten Quelltext, wenn alles gut funktioniert, dann kopieren und einfach in die Fenster der anderen Tabellen hinein kopieren (wieder Doppel-Klick). Dann must Du allerdings bei den Set Bereich_von und Set Bereich_nach die Namen entsprechend ändern: Für Tabelle2 also "Daten2" als von und "Daten1" und "Daten3" als nach. Somit werden alle Blätter immer synchronisiert und immer gleich passend sortiert, allerdings immer wenn eine Zelle auf dem Arbeitsblatt geändert wird! Stattdessen kannst Du den Code auch mit einem Knopf "Aktualisieren" verbinden wenn Du willst...
Hoffe es hat Dir weiergeholfen. Übrigens den VBA-Editor verlässt Du über das kleine X-Symbol in der linken Ecke. ;-)
Gruß Trost Looser