☰

Excel: 2-Wege-Verknüpfung für Zellen in separaten Arbeitsmappen

tag-icon • tag-icon microsoft-excel worksheet-function vba macros links
Excel: 2-Wege-Verknüpfung für Zellen in separaten Arbeitsmappen

Ich bin ganz neu und nicht sicher, ob ich das richtig frage. Ich habe eine Excel-Tabelle, die ich mit einem Kunden teilen möchte, damit wir beide die Informationen bearbeiten und aktualisieren können. Ich möchte jedoch nur einen Abschnitt oder vielleicht nur ein Arbeitsblatt teilen, da ich dort mehrere verschiedene Konten habe, die nicht seine sind. Ich möchte nicht zwei separate Arbeitsmappen aktualisieren und bearbeiten müssen. Ich möchte eine bidirektionale Verknüpfung zwischen der Arbeitsmappe, die ich mit ihm teile, und meiner aktuellen erstellen, sodass bei einer Änderung in der einen die andere automatisch aktualisiert wird und umgekehrt.

Ein früherer Beitrag hat mir dabei geholfen, dies zwischen Arbeitsblättern zu tun, und ich bin begeistert (danke Christofer Weber, es funktioniert großartig). Mir ist klar, dass dafür VBA erforderlich ist, ich komme einfach nicht dahinter. Irgendwelche Ideen? Ich wollte nur das aktuelle VBA ändern, das für die Arbeitsblätter verwendet wird.

Der Momentane

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range(Target.Address), Range("A2:D5")) Is Nothing Then
    Application.EnableEvents = False
    Sheets(1).Range(Target.Address).Value = Target
    Sheets(2).Range(Target.Address).Value = Target
    Sheets(3).Range(Target.Address).Value = Target
    Application.EnableEvents = True
End If
End Sub

Das ist, was ich bisher habe, aber ich weiß, dass die oberste Zeile nicht korrekt ist.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range(Target.Address), Range("A2:D5")) Is Nothing Then
    Application.EnableEvents = False
    Workbooks("Test excel workbook 1 - macro.xlsm").Sheets(1).Range(Target.Address).Value = Target
    Workbooks("Test excel workbook 2 - macro.xlsm").Sheets(1).Range(Target.Address).Value = Target
    Application.EnableEvents = True
End If
End Sub

Antwort1

Ich habe das ausprobiert und denke, es sollte ausreichen, um Ihnen weiterzuhelfen. Aber hier sind einige Dinge, die mir aufgefallen sind.

Zunächst ist zu beachten, dass die IntersectMethode nicht funktioniert, wenn Sie Bereiche in verschiedenen Arbeitsblättern vergleichen.diese Frage. Sie haben das hier nicht explizit getan, aber ich denke, es ist ratsam, anzugeben, mit welchem/welchen Arbeitsblatt/Arbeitsblättern Sie arbeiten, anstatt VBA implizit für Sie entscheiden zu lassen.

Als zweites diese Zeile als Beispiel:

Workbooks("Test excel workbook 1 - macro.xlsm").Sheets(1).Range(Target.Address).Value = Target

Ich persönlich finde es merkwürdig, den Wert eines Bereichs auf einen anderen Bereich festzulegen, anstatt ihn auf denWertdes anderen Bereichs, das stattdessen so aussehen würde:

Workbooks("Test excel workbook 1 - macro.xlsm").Sheets(1).Range(Target.Address).Value = Target.Value

Hier ist der Code, den ich erstellt habe:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Const filePath As String = "C:\some\file\path\otherthing.xlsm"
    Dim otherwb As Workbook
    Dim otherws As Worksheet
    Dim thisws As Worksheet
    Dim rangeIntersection As Range

    'this will allow opening the other workbook without
    'displaying the white UI
    Application.ScreenUpdating = False

    'setting a reference to this worksheet
    Set thisws = ThisWorkbook.Worksheets("Sheet1")
    'opens an unopened workbook or it will simply set a reference
    'to this workbook if it's already opened
    Set otherwb = Excel.Workbooks.Open(filePath)
    'just chose a random worksheet
    Set otherws = otherwb.Worksheets(1)
    'doing the intersection
    Set rangeIntersection = _
        Application.Intersect(Range(Target.Address), _
        thisws.Range("A2:D5"))

    If Not rangeIntersection Is Nothing Then
        Application.EnableEvents = False
        otherws.Range(Target.Address).Value = Target.Value
        Application.EnableEvents = True
    End If

    'uncomment this if you do want to close the wb at the end
'    otherwb.Save
'    otherwb.Close
    Application.ScreenUpdating = True
End Sub

Ich hoffe es hilft

verwandte Informationen