Replikering af farver mellem 2 celler i Excel.

Ved ikke om det er dette du søger, ellers forstå jeg ikke spørgsmålet.

Kopier den celle hvori du har en farve og måske også noget andet.
Gå til den celle du ønsker denne farve.
Højreklik og vælg indsæt specielt
Vælg formater.

Det jeg mener er, hvis man sætter A2 = A1 og A1 er rød, så ønsker jeg også at A2 bliver rød (automatisk). Altså en replikering.

En funktion kan kun returnerer en værdi, og ikke et celle-format. Det skal løses ved hjælp af makro

Her er samme spørgsmål behandler

http://www.eksperten.dk/spm/28310
http://www.eksperten.dk/spm/352977

ups behandlet

Put dette i et alm. modul

Function Repl(ByRef cell As Range)
Repl = cell.Value
End Function


Sub ChangeColor(sht As Object)

Dim x As Range
Dim c As Range
Dim adr As String

Set x = sht.UsedRange.SpecialCells(xlCellTypeFormulas, 1)
For Each c In x
    If c.Formula Like "=repl(*" Then
    adr = Mid(c.Formula, 7, Len(c.Formula) - 7)
    c.Interior.ColorIndex = Range(adr).Interior.ColorIndex
    End If
Next
  For Each c In x
    If c.Formula Like "=repl(*" Then
    adr = Mid(c.Formula, 7, Len(c.Formula) - 7)
    c.Interior.ColorIndex = Range(adr).Interior.ColorIndex
    End If
Next
End Sub


** og dette her i ThisWorkBook-modulet

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
ChangeColor Sh
End Sub

I stedet for at referere direkte til A1  (=A1) så brug formlen
=repl(A1)

Når arket genberegnes, vil farven på cellen med formlen repl blive den samme som i A1

Dette er ikke en 100% løsning, men du kan da komme videre.

PS. Hvis du ser nøjere efter kan du se at cellerne gennemløbes to gange i ChangeColor. Årsagen til dette er den rækkefølge excel beregner cellerne i, ellers vil give et forkert resultat.

Hvis du har mange formler så udskift ChangeColor med denne. Den skulle gerne være noget hurtigere.

Sub ChangeColor(sht As Object)
Dim rUsed As Range
Dim rCell As Range
Dim rRepl As Range
Dim lCounter As Long
Dim sAdr As String
lCounter = 0
Set rUsed = sht.UsedRange.SpecialCells(xlCellTypeFormulas, 23)
For Each rCell In rUsed
  If rCell.Formula Like "=repl(*" Then
      sAdr = Mid(rCell.Formula, 7, Len(rCell.Formula) - 7)
      rCell.Interior.ColorIndex = Range(sAdr).Interior.ColorIndex
      lCounter = lCounter + 1
      If lCounter >= 2 Then Set rRepl = Union(rRepl, rCell) Else Set rRepl = rCell
  End If
Next
For Each rCell In rRepl
    sAdr = Mid(rCell.Formula, 7, Len(rCell.Formula) - 7)
    rCell.Interior.ColorIndex = Range(sAdr).Interior.ColorIndex
Next
End Sub

Du må få bak til at oprette et svar så du kan få lukket dette spørgsmål.