vba Verknüpfung beidseitig bearbeiten

Question

Hallo Zusammen, könnte mir jemand ein Makro schreiben ich möchte zum Bsp.

Tabelle "test1" die Zeilen K8:K100 mit Tabelle "test2" Zeile G8:G100 verknüpfen so dass ich sie beidseitig bearbeiten kann? 
Damit ich in Tabelle "test1" Zeile K8:K100 und Tabelle "test2" Zeile G8:G100 eine Zahl eingeben kann und es mir immer die nicht bearbeitete Zelle aktualisiert? 

Habe ein ähnliches Beispiel gefunden.

Private Sub Worksheet_Change(ByVal Target As Range) 
Application.EnableEvents = False 
On Error GoTo ERRORHANDLER 
If Target.Cells.Address = "$A$1" Then 
Range("A5") = Range("A1") 
ElseIf Target.Cells.Address = "$A$5" Then 
Range("A1") = Range("A5") 
End If 
ERRORHANDLER: 
Application.EnableEvents = True 
End Sub

Besten Dank.

Answer 1

Hallo Karin habe den Code unten eingefügt und diese Fehlermeldung bekommen, was habe ich falsch gemacht ??

Private Sub Worksheet_Change(ByVal Target As Range) 'Von Tabelle "test1" Zelle T6 in Tabelle "test2" einfügen

    Dim rngZelle As Range

    Set rngZelle = Worksheets("test2").Range("A50:A68").Find(Worksheets("test1").Range("S6"), lookat:=xlWhole)

    If Not rngZelle Is Nothing Then rngZelle.Offset(0, 2) = Worksheets("test1").Range("T6")

    Worksheets("test1").Range("U6") = rngZelle.Offset(0, 4).Value

End Sub

Answer 2

Hi,

du hast nichts falsch gemacht - das ist ein Fehler, der nicht zwangsläufig ständig auftritt und man kann nicht genau festlegen, aus welchem Grund er auftritt. Das einzige was mir einfällt wäre, wenn du den Code wie folgt änderst:

    Dim rngZelle As Range
    Dim strSuche As String
    strSuche = Worksheets("test1").Range("S6")
    Set rngZelle = Worksheets("test2").Range("A50:A68").Find(strSuche, lookat:=xlWhole)
    If Not rngZelle Is Nothing Then
        rngZelle.Offset(0, 2) = Worksheets("test1").Range("T6")
        Worksheets("test1").Range("U6") = rngZelle.Offset(0, 4).Value
    End If

Falls diese Änderung nicht hilft, dann müsstest du die Mappe bereitstellen damit man testen kann.

Bis später, Karin

Answer 3

 Hallo Karin guten Tag habe die Datei hochgeladen, ich möchte aus der Tabelle “test1“ Zelle S6 den text aus Tabelle “test2“ Zellen A50:A68 suchen (finden) und die Nummer aus Tabelle “test1“ Zelle T6 in die Tabelle “test2“ in die jeweilige Zelle C50:C68 einfügen (bis hier her funktioniert es super nachher die Fehlermeldung), und die jeweilige Zahl aus Tabelle “test2“ Zelle E50:E68 in die Tabelle “test1“ U6 einfügen.

Vielen Dank.

https://supportnet.de/forum/?qa=blob&qa_blobid=15284689964657082839

Answer 4

Hi,

da du den Code ins Worksheet_Change-Ereignis eingetragen hast (habe ich bei deinem vorhergehenden Beitrag übersehen, weil der Code schlecht zu lesen ist da nicht als Code formatiert), wird dein Code bei jedem Eintrag in eine beliebige Zelle im Tabellenblatt ausgeführt und er wird fortlaufend in einer Schleife immer wieder durchlaufen - dadurch kommt es zu diesem Fehler. Du musst also genau festlegen, bei Eintrag in welche Zelle(n) der Code ausgeführt werden soll und nur dann - das ist ganz wichtig wenn man das Change-Ereignis verwendet.

Ich nehme an, dass er nur ausgeführt werden soll, wenn du in T6 eine Zahl einträgst?  Der Code müsste dann so aussehen:

Private Sub Worksheet_Change(ByVal Target As Range) 'Von Tabelle "test1" Zelle T6 in Tabelle "test2" einfügen
    Dim rngZelle As Range
    If Target.Cells(1).Address(False, False) = "T6" Then
        ' Eingabe ist eine Zahl
        If IsNumeric(Target.Value) Then
            ' Zelle S6 ist nicht leer
            If Target.Offset(0, -1) <> "" Then
                ' in "test2" nach dem Inhalt der Zelle links neben T6 suchen
                Set rngZelle = Worksheets("test2").Range("A50:A68").Find(Target.Offset(0, -1), lookat:=xlWhole)
                ' Suchtext wurde gefunden
                If Not rngZelle Is Nothing Then
                    ' in "test2" die Eingabe übernehmen
                    rngZelle.Offset(0, 2) = Target.Value
                    ' jeweilige Zahl aus Tabelle "test2" Zelle E50:E68 in Zelle rechts neben Eingabezelle (U6) einfügen
                    Target.Offset(0, 1).Value = rngZelle.Offset(0, 4).Value
                End If
            End If
        End If
    End If
End Sub

Bis später, Karin

PS: Übrigens kannst du einen Code der besseren Lesbarkeit zuliebe im Beitrag als Code formatieren - dazu zuerst den Code im Beitrag einfügen, dann den eingefügten Code markieren, oberhalb des Antwortfensters den 3. Schalter in der mittleren Reihe (Standardeinstellung: Normal) anklicken und ganz unten "Code" auswählen.

Answer 5

Hallo Karin, habe noch nicht alles getestet aber ich glaube das wird funktionieren nochmals besten Dank.

Answer 6

Hallo Karin, brauch wieder deine Hilfe.

währe es möglich dass nicht nur die Spalte ("K8:K100") sondern auch die Spalten ("L8:L100") und ("O8:O100") gleich funktionieren wie ("K8:K100"). Vielen Dank.

für test2 dieser Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim varZeile As Variant
    ' Eingabe erfolgt in K8:K100
    If Not Intersect(Target.Cells(1), Range("K8:K100")) Is Nothing Then
        ' Zeile ermitteln in welcher in B8:B100 test1 der Inhalt aus Eingabezeile Spalte B steht
        varZeile = Application.Match(Target.Cells(1).Offset(0, -9), Worksheets("test1").Range("B8:B100"), 0)
        ' Zeile konnte ermittelt werden dann in K8:K100 test1 Eingabe eintragen
        If IsNumeric(varZeile) Then Worksheets("test1").Range("B8:B100").Cells(varZeile).Offset(0, 9) = Target
    End If
End Sub

Answer 7

Hi,

ungetestet:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim varZeile As Variant
    ' Eingabe erfolgt in K8:K100, L8:L100, O8:O100
    If Not Intersect(Target.Cells(1), Range("K8:K100"), Range("L8:L100"), Range("O8:O100")) Is Nothing Then
        ' Zeile ermitteln in welcher in B8:B100 test1 der Inhalt aus Eingabezeile Spalte B steht
        varZeile = Application.Match(Cells(Target.Cells(1).Row, 2), Worksheets("test1").Range("B8:B100"), 0)
        ' Zeile konnte ermittelt werden dann in test1 Eingabe eintragen
        If IsNumeric(varZeile) Then Worksheets("test1").Cells(Target.Cells(1).Row, Target.Cells(1).Column) = Target
    End If
End Sub

Bis später, Karin

Answer 8

Besten Dank, das ist SUPER.

Answer 9

Hallo Karin,

Entschuldigung ich habe es getestet jetzt funktionieren alle 3 (K, L, und O) nicht mehr Bitte um Hilfe, Danke.

Answer 10

Hi,

was genau verstehst du unter "funktionieren nicht mehr"? Mit solch einer Aussage kann man leider absolut nichts anfangen.

Bis später, Karin