27. april 2010 - 15:45Der er
3 kommentarer og 1 løsning
EXCEL - Oprettelse af "cirkulær reference"
Jeg har en del ark som skal kunne opdaterer et felt begge veje.
Dvs. ændre jeg tallet i feltet på ark1 skal ændringen også optræde i ark2-ark3 osv. - samtidig skal det også være sådan at hvis jeg ændre tallet i feltet på ark2 skal ændringen også optræde i ark1 og ark3 osv.
Jeg har forsøgt at oprette et link mellem felterne både den ene vej og den anden vej men når jeg opretter link den anden vej får jeg at vide det er en "cirkulær reference" det er det jo egentlig også da den jo i virkeligheden forsøger at opdaterer sig selv. Der står samtidig i advarsels feltet at Excel kan have svært ved at opdaterer arket når der findes den slags "cirkulære referencer"
Hvordan er den korrekte metode til at oprette disse felter?
Det er ikke nogen særlig elegant løsning. Indholdet i den celle der kopieres til vil være en formel der linker til den celle der kopieres fra, ikke værdien fra den celle, men det virker.
Jeg forestiller mig en fil med 5 ark hvor værdien i celle A1 ønskes at være ens på alle ark uanset hvilket ark den rettes i.
Du får lige koden til alle 5 ark.
Koden til Ark1: Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then Application.EnableEvents = False If IsEmpty(Target.Value) Then Sheets("Ark2").Range("A1").ClearContents Sheets("Ark3").Range("A1").ClearContents Sheets("Ark4").Range("A1").ClearContents Sheets("Ark5").Range("A1").ClearContents ElseIf Target.Value <> "" Then Application.CutCopyMode = False Sheets("Ark2").Range("A1") = "=Ark1!A1" Sheets("Ark3").Range("A1") = "=Ark1!A1" Sheets("Ark4").Range("A1") = "=Ark1!A1" Sheets("Ark5").Range("A1") = "=Ark1!A1" End If Application.EnableEvents = True End If End Sub
Koden til Ark2: Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then Application.EnableEvents = False If IsEmpty(Target.Value) Then Sheets("Ark1").Range("A1").ClearContents Sheets("Ark3").Range("A1").ClearContents Sheets("Ark4").Range("A1").ClearContents Sheets("Ark5").Range("A1").ClearContents ElseIf Target.Value <> "" Then Application.CutCopyMode = False Sheets("Ark1").Range("A1") = "=Ark2!A1" Sheets("Ark3").Range("A1") = "=Ark2!A1" Sheets("Ark4").Range("A1") = "=Ark2!A1" Sheets("Ark5").Range("A1") = "=Ark2!A1" End If Application.EnableEvents = True End If End Sub
Koden til Ark3: Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then Application.EnableEvents = False If IsEmpty(Target.Value) Then Sheets("Ark1").Range("A1").ClearContents Sheets("Ark2").Range("A1").ClearContents Sheets("Ark4").Range("A1").ClearContents Sheets("Ark5").Range("A1").ClearContents ElseIf Target.Value <> "" Then Application.CutCopyMode = False Sheets("Ark1").Range("A1") = "=Ark3!A1" Sheets("Ark2").Range("A1") = "=Ark3!A1" Sheets("Ark4").Range("A1") = "=Ark3!A1" Sheets("Ark5").Range("A1") = "=Ark3!A1" End If Application.EnableEvents = True End If End Sub
Koden til Ark4: Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then Application.EnableEvents = False If IsEmpty(Target.Value) Then Sheets("Ark1").Range("A1").ClearContents Sheets("Ark2").Range("A1").ClearContents Sheets("Ark3").Range("A1").ClearContents Sheets("Ark5").Range("A1").ClearContents ElseIf Target.Value <> "" Then Application.CutCopyMode = False Sheets("Ark1").Range("A1") = "=Ark4!A1" Sheets("Ark2").Range("A1") = "=Ark4!A1" Sheets("Ark3").Range("A1") = "=Ark4!A1" Sheets("Ark5").Range("A1") = "=Ark4!A1" End If Application.EnableEvents = True End If End Sub
Koden til Ark5: Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then Application.EnableEvents = False If IsEmpty(Target.Value) Then Sheets("Ark1").Range("A1").ClearContents Sheets("Ark2").Range("A1").ClearContents Sheets("Ark3").Range("A1").ClearContents Sheets("Ark4").Range("A1").ClearContents ElseIf Target.Value <> "" Then Application.CutCopyMode = False Sheets("Ark1").Range("A1") = "=Ark5!A1" Sheets("Ark2").Range("A1") = "=Ark5!A1" Sheets("Ark3").Range("A1") = "=Ark5!A1" Sheets("Ark4").Range("A1") = "=Ark5!A1" End If Application.EnableEvents = True End If End Sub
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
