AW: 2 Felder automatisch abgleichen
07.02.2006 11:30:30
UweD
Hallo
wenn es eine Begrenzte Anzahl von Zellpaaren ist, ginge es so...
ist eben nur ein wenig Arbeit die Verbindungen zu programmieren.
hier mal für 2 Zellpaare..
- rechtsclick auf den Tabellenblattreiter unten
- Code anzeigen
- Makro ins rechte Fenster kopieren
Private Sub Worksheet_Change(ByVal Target As Range)
Dim RG
On Error GoTo Fehler
Application.EnableEvents = False
Set RG = Union([A1], [C1], [A2], [C2])
If Not Intersect(Target, RG) Is Nothing Then
Select Case Target.Address(RowAbsolute:=False, ColumnAbsolute:=False)
Case "A1"
[C1] = Target.Value
Case "C1"
[A1] = Target.Value
Case "A2"
[C2] = Target.Value
Case "C2"
[A2] = Target.Value
End Select
End If
Fehler:
If Err.Number <> 0 Then MsgBox "Fehler: " & Err.Number & " " & Err.Description
Application.EnableEvents = True
End Sub
Gruß UweD
(Rückmeldung wäre schön)