Du hast nicht grundsätzlich falsch gedacht, ...
02.11.2021 05:17:28
Luc:-?
…Laura,
denn es geht tatsächlich, auch wenn ich kein Freund von Datenübernahmen aus anderen Dateien per DirektVerlinkung bin, weil das u.U. zu ziemlichem KorrekturAufwand führen kann, wenn QuellDateien verschoben wdn und dabei die ZielDatei nicht geöffnet ist.
Aber in diesem lt BspDateien relativ einfachen Fall habe ich dein Problem mit 2 VBA-EreignisProzeduren auf Blatt1 der Datei B gelöst. Wird nun auf Datei A der identifikationsrelevante Bereich (Spalten A:C) umsortiert, wird auf dem ZielBlatt der Datei B das Berechnungsereignis (~_Calculate) ausgelöst, das dafür sorgt, dass die Angaben der Spalte D wieder richtig zugeordnet wdn. Das setzt allerdings voraus, dass die Ziele (HauptIdentifikator) bekannt sind.
Ich habe das so gelöst, dass bei Eintrag DateiB-Blatt1-Spalte D (relevanter Bereich) auf dieser Zelle ein ZellKommentar angelegt wird (Änderungsereignis ~_Change, wird auch von ~_Calculate bei Umpositionierung in Spalte D ausgelöst), der die Angaben in Spalten A:C gleicher Zeile zu einem Identifikator zusammengefasst enthält. Das muss also für alle bereits in Datei B / Blatt 1 / Spalte D vorhandenen Einträge nachgeholt wdn (einfach neu auswählen), sobald die EreignisProzeduren im VBE-Modul des Blattes 1 der Datei B (im VBE-VerzeichnisBaum des VBA-Projekts ersichtlich) erfolgt sind. Dafür müssen die Entwickler-Tools installiert sein! Die Datei B muss dann als .xlsm oder .xlsb gespeichert wdn. Der Inhalt dieses Dokument-KlassenModuls sähe dann so aus:
Option Explicit
Rem Falls die als Const angegebenen Bereichsadressen sich (ggf durch verschieben) verändern sollten,
' werdn sie hier nicht automatisch geändert. Das kann man nur erreichen, indem sie unter definier-
' ten Namen angelegt wdn u. unter Const dieser Name analog anstelle der AdressAngabe benutzt wird.
Private Sub Worksheet_Calculate()
Const relCol As Long = 4, adBezBer = "A1:C27", adRelBer$ = "D2:D27"
Dim rix As LongPtr, zRBzl As LongPtr, avBBzl, avRBzl, xBBzl, xRBzl, xRBZ As Range
For Each xRBZ In Me.Range(adRelBer)
If Not IsEmpty(xRBZ) Then
With WorksheetFunction
If xRBZ.Comment.Text Join(.Transpose(.Transpose(Me.Range(adBezBer).Rows(xRBZ.Row))), "") Then
avRBzl = avRBzl & " " & xRBZ.Row
End If
End With
End If
Next xRBZ
If Not IsEmpty(avRBzl) Then
ReDim avBBzl(Me.Range(adBezBer).Rows.Count - 1)
For Each xBBzl In Me.Range(adBezBer).Rows
With WorksheetFunction
avBBzl(rix) = Join(.Transpose(.Transpose(xBBzl)), ""): rix = rix + 1
End With
Next xBBzl
avRBzl = Split(LTrim(avRBzl))
For Each xRBzl In avRBzl
zRBzl = WorksheetFunction.Match(Me.Cells(CLng(xRBzl), relCol).Comment.Text, avBBzl, 0)
If CBool(zRBzl) Then
Me.Cells(zRBzl, relCol) = Me.Cells(CLng(xRBzl), relCol)
With Me.Cells(CLng(xRBzl), relCol)
.ClearContents: .ClearComments: zRBzl = 0
End With
End If
Next xRBzl
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Const adBezBer = "A1:C27", adRelBer$ = "D2:D27"
Dim txCom$, avBezZl
On Error Resume Next
If Not Intersect(Target, Me.Range(adRelBer)) Is Nothing Then
If Not IsEmpty(Target) Then
With WorksheetFunction
txCom = Join(.Transpose(.Transpose(Me.Range(adBezBer).Rows(Target.Row))), "")
End With
If Not Target.Comment Is Nothing Then Target.Comment.Delete
Target.AddComment txCom:
With Target.Comment.Shape: .Height = 12: .Width = 40: End With
End If
End If
End Sub
Das Filtern des Blattes 1 der Datei A hat übrigens keinen Einfluss auf die Datei B (für Datei B scheint das ja nicht vorgesehen zu sein). Bei Sortierung nach dem Filtern wdn die ausgeblendeten Zeilen nur nicht mitsortiert, was dann allerdings auch in Datei B zu bemerken ist.
Viel Erfolg! Morhn, Luc :-?
Die universelle Befähigung zur Unfähigkeit macht jede menschliche Leistung zu einem unglaublichen Wunder. Stapps ironisches Paradoxon