Note: The other languages of the website are Google-translated. Back to English

Hur ändrar jag formfärg baserat på cellvärde i Excel?

Ändra formfärgen baserat på ett visst cellvärde kan vara en intressant uppgift i Excel, till exempel, om cellvärdet i A1 är mindre än 100 är formfärgen röd, om A1 är större än 100 och mindre än 200 är formfärgen är gul och när A1 är större än 200 är formfärgen grön enligt följande skärmdump. För att ändra formens färg baserat på ett cellvärde introducerar den här artikeln metod för dig.

doc ändra formfärg 1

Ändra formfärg baserat på cellvärde med VBA-kod


pil blå höger bubbla Ändra formfärg baserat på cellvärde med VBA-kod

Nedanstående VBA-kod kan hjälpa dig att ändra formfärgen baserat på ett cellvärde, gör så här:

1. Högerklicka på arkfliken där du vill ändra formfärg och välj sedan Visa kod från snabbmenyn, i poppade ut Microsoft Visual Basic för applikationer kopiera och klistra in följande kod i tomt Modulerna fönster.

VBA-kod: Ändra formfärg baserat på cellvärde:

Private Sub Worksheet_Change(ByVal Target As Range)
'Updateby Extendoffice 20160704
    If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) Then
        If Target.Value < 100 Then
            ActiveSheet.Shapes("Oval 1").Fill.ForeColor.RGB = vbRed
        ElseIf Target.Value >= 100 And Target.Value < 200 Then
            ActiveSheet.Shapes("Oval 1").Fill.ForeColor.RGB = vbYellow
        Else
            ActiveSheet.Shapes("Oval 1").Fill.ForeColor.RGB = vbGreen
        End If
    End If
End Sub

doc ändra formfärg 2

2. Och sedan när du anger värdet i cell A1 ändras formfärgen med cellvärdet som du definierade.

Anmärkningar: I ovanstående kod, A1 är cellvärdet som din formfärg skulle ändras baserat på, och Oval 1 är formnamnet på den infogade formen kan du ändra dem efter behov.


De bästa Office-produktivitetsverktygen

Kutools för Excel löser de flesta av dina problem och ökar din produktivitet med 80%

  • återanvändning: Sätt snabbt i komplexa formler, diagram och allt som du har använt tidigare; Kryptera celler med lösenord; Skapa e-postlista och skicka e-post ...
  • Super Formula Bar (enkelt redigera flera rader med text och formel); Läslayout (enkelt läsa och redigera ett stort antal celler); Klistra in i filtrerat intervall...
  • Sammanfoga celler / rader / kolumner utan att förlora data; Delat cellinnehåll; Kombinera duplicerade rader / kolumner... Förhindra duplicerade celler; Jämför intervall...
  • Välj Duplicera eller Unikt Rader; Välj tomma rader (alla celler är tomma); Super Find och Fuzzy Find i många arbetsböcker; Slumpmässigt val ...
  • Exakt kopia Flera celler utan att ändra formelreferens; Skapa referenser automatiskt till flera ark; Sätt in kulor, Kryssrutor och mer ...
  • Extrahera text, Lägg till text, ta bort efter position, Ta bort mellanslag; Skapa och skriva ut personsökningstalsatser; Konvertera mellan celler innehåll och kommentarer...
  • Superfilter (spara och tillämpa filterscheman på andra ark); Avancerad sortering efter månad / vecka / dag, frekvens och mer; Specialfilter av fet, kursiv ...
  • Kombinera arbetsböcker och arbetsblad; Sammanfoga tabeller baserat på nyckelkolumner; Dela data i flera ark; Batchkonvertera xls, xlsx och PDF...
  • Mer än 300 kraftfulla funktioner. Stöder Office / Excel 2007-2021 och 365. Stöder alla språk. Enkel implementering i ditt företag eller organisation. Fullständiga funktioner 30 dagars gratis provperiod. 60 dagars pengarna tillbaka-garanti.
kte-flik 201905

Fliken Office ger ett flikgränssnitt till Office och gör ditt arbete mycket enklare

  • Aktivera flikredigering och läsning i Word, Excel, PowerPoint, Publisher, Access, Visio och Project.
  • Öppna och skapa flera dokument i nya flikar i samma fönster, snarare än i nya fönster.
  • Ökar din produktivitet med 50 % och minskar hundratals musklick för dig varje dag!
officetab botten
Sortera kommentarer efter
Kommentarer (21)
Klassad 4 av 5 · 1 betyg
Denna kommentar minimerades av moderatoren på webbplatsen
Vad sägs om om vi har mer än 1 objekt i arbetsbladet som färgerna ändras enligt värdeinmatningen säg i A1, B1,C1....
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Edward,
Glad att hjälpa till. Vänligen kopiera och klistra in nedanstående VBA-kod i det tomma modulfönstret.

Sub TestMacro2()
Dim dblHt As Double
Dim rngC As Range
Dim lngr As Long
Dim dblMargin As Double
Dim lngSR As Long

lngSR = 2 'Rad där data börjar

dblMargin = 6 ' Avstånd mellan former

'Om fel återuppta nästa
ActiveSheet.Shapes.SelectAll
Urval. Radera
På Fel GoTo 0


dblHt = Rader(lngSR). Höjd * 4

För lngr = lngSR To Cells(lngSR, "A").End(xlDown).Rad
ActiveSheet.Shapes.AddShape(msoShapeOval, _
Celler(lngSR, "D"). Vänster + ((lngr - lngSR) Mod 4) * dblHt + dblMargin, _
Cells(lngSR, "D").Top + Int((lngr - lngSR) / 4) * dblHt + dblMargin, _
dblHt - 2 * dblMargin, _
dblHt - 2 * dblMargin). Välj
Selection.Name = "Round" & Cells(lngr, "A").Address
Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Cells(lngr, "A").Value
Med Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignCenter
Sluta med
Med Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).Teckensnitt
.Fet = msoTrue
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fyll.Solid
.Storlek = 12
Sluta med
Med Selection.ShapeRange.Fill
.Synlig = msoTrue
If Cells(lngr, "A").Värde > 70 Då
.ForeColor.RGB = RGB(0; 176; 80)
ElseIf Cells(lngr, "A").Värde >= 40 Då
.ForeColor.RGB = RGB(255; 255; 70)
annars
.ForeColor.RGB = RGB(255; 0; 0)
End If
.Transparens = 0
.Fast
Sluta med
Nästa lngr
Range("A1"). Välj
End Sub

När du har kört VBA-koden ovan kommer du att se att flera former genereras och färgerna på dessa former ändras enligt VBA.
Se min skärmdump. Hoppas det kan hjälpa. Ha en bra dag.
Vänliga hälsningar,
Mandy
Denna kommentar minimerades av moderatoren på webbplatsen
Jag har 300 former i ett ark. Är det möjligt att kontrollera den intilliggande eller länkade cellens värde (tom eller icke-tom) i ett ark och färglägga de länkade formerna genom VBA-kod?
Denna kommentar minimerades av moderatoren på webbplatsen
Bra vba-lösning.

Det är möjligt att även använda villkorlig formatering för att färglägga formerna.

Ställ in namnet på varje form som cellvärde. Använd en med varje form och ställ sedan in formfärgen som cellfärg för alla namngivna former.

Cellfärgen kan ändras med villkorlig formatering baserat på numeriska värden.

Till exempel kan färgen på en halvtransparent överlappning på en stadskarta användas för att grafiskt indikera befolkningstäthet per block med ett graderat färgschema.
Denna kommentar minimerades av moderatoren på webbplatsen
Kan du dela med dig av ett exempel på koden?
Denna kommentar minimerades av moderatoren på webbplatsen
Hur kan detta tillämpas om du har flera former i samma kalkylblad?
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Yasir,
Glad att hjälpa till. Vänligen kopiera och klistra in nedanstående VBA-kod i det tomma modulfönstret.

Sub TestMacro2()
Dim dblHt As Double
Dim rngC As Range
Dim lngr As Long
Dim dblMargin As Double
Dim lngSR As Long

lngSR = 2 'Rad där data börjar

dblMargin = 6 ' Avstånd mellan former

'Om fel återuppta nästa
ActiveSheet.Shapes.SelectAll
Urval. Radera
På Fel GoTo 0


dblHt = Rader(lngSR). Höjd * 4

För lngr = lngSR To Cells(lngSR, "A").End(xlDown).Rad
ActiveSheet.Shapes.AddShape(msoShapeOval, _
Celler(lngSR, "D"). Vänster + ((lngr - lngSR) Mod 4) * dblHt + dblMargin, _
Cells(lngSR, "D").Top + Int((lngr - lngSR) / 4) * dblHt + dblMargin, _
dblHt - 2 * dblMargin, _
dblHt - 2 * dblMargin). Välj
Selection.Name = "Round" & Cells(lngr, "A").Address
Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Cells(lngr, "A").Value
Med Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignCenter
Sluta med
Med Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).Teckensnitt
.Fet = msoTrue
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fyll.Solid
.Storlek = 12
Sluta med
Med Selection.ShapeRange.Fill
.Synlig = msoTrue
If Cells(lngr, "A").Värde > 70 Då
.ForeColor.RGB = RGB(0; 176; 80)
ElseIf Cells(lngr, "A").Värde >= 40 Då
.ForeColor.RGB = RGB(255; 255; 70)
annars
.ForeColor.RGB = RGB(255; 0; 0)
End If
.Transparens = 0
.Fast
Sluta med
Nästa lngr
Range("A1"). Välj
End Sub

När du har kört VBA-koden ovan kommer du att se att flera former genereras och färgerna på dessa former ändras enligt VBA.
Se min skärmdump. Hoppas det kan hjälpa. Ha en bra dag.
Vänliga hälsningar,
Mandy
Denna kommentar minimerades av moderatoren på webbplatsen
Tack för detta som är riktigt användbart.

Jag vill nu använda den med en pivottabell på ett annat kalkylblad som styr data på arket med formerna som jag vill ändra färg. Men när jag ändrar markeringen i pivottabellen uppdateras data på kalkylbladet med formerna men koden körs inte så formerna ändrar inte färg

Om jag manuellt ändrar värdena körs koden och färgen på formerna uppdateras.

Fråga: vad behöver jag lägga till i koden ovan för att den ska köras automatiskt?
Denna kommentar minimerades av moderatoren på webbplatsen
Hur får jag den privata suben att läsa resultatet från AVERAGE(C1,C5,C9)-beräkningen?

Sub fungerar bara med numeriska värden; alla tankar och förslag är mycket uppskattade.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Cesare, hur mår du? Jag märker att VBA-koden kan fungera med AVERAGE(antal, number...) beräkning. Men tricket är att varje gång du ändrar värdena i beräkningen måste du dubbelklicka på formeln i cellen för att få VBA att fungera igen. 
Till exempel, i cell A1, efter att vi matat in formeln är =MEDEL(C2:D3), fungerar VBA och ändrar färgen på formen därefter. Se skärmdump 1. C0.2:D2, det returnerade resultatet i cell A3 ändras, men formfärgen har inte ändrats ännu. I det här fallet måste vi dubbelklicka på formeln i cell A1 för att få VBA att fungera. Då kommer formfärgen att ändras därefter. Se skärmdump 1 och 2.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej ... utmärkt lösning ... men hur applicerar jag det på flera former baserat på motsvarande värden för ett cellområde. Stort tack på förhand för din hjälp.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Ryan,
Glad att hjälpa till. Vänligen kopiera och klistra in nedanstående VBA-kod i det tomma modulfönstret.

Sub TestMacro2()
Dim dblHt As Double
Dim rngC As Range
Dim lngr As Long
Dim dblMargin As Double
Dim lngSR As Long

lngSR = 2 'Rad där data börjar

dblMargin = 6 ' Avstånd mellan former

'Om fel återuppta nästa
ActiveSheet.Shapes.SelectAll
Urval. Radera
På Fel GoTo 0


dblHt = Rader(lngSR). Höjd * 4

För lngr = lngSR To Cells(lngSR, "A").End(xlDown).Rad
ActiveSheet.Shapes.AddShape(msoShapeOval, _
Celler(lngSR, "D"). Vänster + ((lngr - lngSR) Mod 4) * dblHt + dblMargin, _
Cells(lngSR, "D").Top + Int((lngr - lngSR) / 4) * dblHt + dblMargin, _
dblHt - 2 * dblMargin, _
dblHt - 2 * dblMargin). Välj
Selection.Name = "Round" & Cells(lngr, "A").Address
Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Cells(lngr, "A").Value
Med Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignCenter
Sluta med
Med Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).Teckensnitt
.Fet = msoTrue
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fyll.Solid
.Storlek = 12
Sluta med
Med Selection.ShapeRange.Fill
.Synlig = msoTrue
If Cells(lngr, "A").Värde > 70 Då
.ForeColor.RGB = RGB(0; 176; 80)
ElseIf Cells(lngr, "A").Värde >= 40 Då
.ForeColor.RGB = RGB(255; 255; 70)
annars
.ForeColor.RGB = RGB(255; 0; 0)
End If
.Transparens = 0
.Fast
Sluta med
Nästa lngr
Range("A1"). Välj
End Sub

När du har kört VBA-koden ovan kommer du att se att flera former genereras och färgerna på dessa former ändras enligt VBA.
Se min skärmdump. Hoppas det kan hjälpa. Ha en bra dag.
Vänliga hälsningar,
Mandy
Denna kommentar minimerades av moderatoren på webbplatsen
¿Cómo hacemos si tenemos más de 1 Oval en la hoja de trabajo cuyos colores cambian de acuerdo con el valor ingresado, por ejemplo, en A1, B1, C1...? Mil gracias por su ayuda!

Denna kommentar minimerades av moderatoren på webbplatsen
Hej María Noel,
Glad att hjälpa till. Vänligen kopiera och klistra in nedanstående VBA-kod i det tomma modulfönstret.

Sub TestMacro2()
Dim dblHt As Double
Dim rngC As Range
Dim lngr As Long
Dim dblMargin As Double
Dim lngSR As Long

lngSR = 2 'Rad där data börjar

dblMargin = 6 ' Avstånd mellan former

'Om fel återuppta nästa
ActiveSheet.Shapes.SelectAll
Urval. Radera
På Fel GoTo 0


dblHt = Rader(lngSR). Höjd * 4

För lngr = lngSR To Cells(lngSR, "A").End(xlDown).Rad
ActiveSheet.Shapes.AddShape(msoShapeOval, _
Celler(lngSR, "D"). Vänster + ((lngr - lngSR) Mod 4) * dblHt + dblMargin, _
Cells(lngSR, "D").Top + Int((lngr - lngSR) / 4) * dblHt + dblMargin, _
dblHt - 2 * dblMargin, _
dblHt - 2 * dblMargin). Välj
Selection.Name = "Round" & Cells(lngr, "A").Address
Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Cells(lngr, "A").Value
Med Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignCenter
Sluta med
Med Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).Teckensnitt
.Fet = msoTrue
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fyll.Solid
.Storlek = 12
Sluta med
Med Selection.ShapeRange.Fill
.Synlig = msoTrue
If Cells(lngr, "A").Värde > 70 Då
.ForeColor.RGB = RGB(0; 176; 80)
ElseIf Cells(lngr, "A").Värde >= 40 Då
.ForeColor.RGB = RGB(255; 255; 70)
annars
.ForeColor.RGB = RGB(255; 0; 0)
End If
.Transparens = 0
.Fast
Sluta med
Nästa lngr
Range("A1"). Välj
End Sub

När du har kört VBA-koden ovan kommer du att se att flera former genereras och färgerna på dessa former ändras enligt VBA.
Se min skärmdump. Hoppas det kan hjälpa. Ha en bra dag.
Vänliga hälsningar,
Mandy
Denna kommentar minimerades av moderatoren på webbplatsen
Jättebra lösning! Hur kan jag göra om jag har mer än 1 oval i kalkylbladet där färgerna ändras enligt värdeinmatningen säg i A1, B1,C1? Tack på förhand för ditt svar! 
Denna kommentar minimerades av moderatoren på webbplatsen
Hej mnsosa, Jag hjälper gärna till. Vänligen kopiera och klistra in nedanstående VBA-kod i det tomma modulfönstret.
Sub TestMacro2()
Dim dblHt As Double
Dim rngC As Range
Dim lngr As Long
Dim dblMargin As Double
Dim lngSR As Long

lngSR = 2 'Rad där data börjar

dblMargin = 6 ' Avstånd mellan former

'Om fel återuppta nästa
ActiveSheet.Shapes.SelectAll
Urval. Radera
På Fel GoTo 0


dblHt = Rader(lngSR). Höjd * 4

För lngr = lngSR To Cells(lngSR, "A").End(xlDown).Rad
ActiveSheet.Shapes.AddShape(msoShapeOval, _
Celler(lngSR, "D"). Vänster + ((lngr - lngSR) Mod 4) * dblHt + dblMargin, _
Cells(lngSR, "D").Top + Int((lngr - lngSR) / 4) * dblHt + dblMargin, _
dblHt - 2 * dblMargin, _
dblHt - 2 * dblMargin). Välj
Selection.Name = "Round" & Cells(lngr, "A").Address
Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Cells(lngr, "A").Value
Med Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignCenter
Sluta med
Med Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).Teckensnitt
.Fet = msoTrue
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fyll.Solid
.Storlek = 12
Sluta med
Med Selection.ShapeRange.Fill
.Synlig = msoTrue
If Cells(lngr, "A").Värde > 70 Då
.ForeColor.RGB = RGB(0; 176; 80)
ElseIf Cells(lngr, "A").Värde >= 40 Då
.ForeColor.RGB = RGB(255; 255; 70)
annars
.ForeColor.RGB = RGB(255; 0; 0)
End If
.Transparens = 0
.Fast
Sluta med
Nästa lngr
Range("A1"). Välj
End Sub

När du har kört VBA-koden ovan kommer du att se att flera former genereras och färgerna på dessa former ändras enligt VBA. Se min skärmdump. Hoppas det kan hjälpa. Ha en trevlig dag. Med vänliga hälsningar, Mandy
Denna kommentar minimerades av moderatoren på webbplatsen
Jag är ny på VBA och kämpar med något. Jag måste ha 9 olika celler A1-A9 ändra färgen på 9 olika objekt. Objekt är kuber 1-9. Bara för att förtydliga, varje cell ska bara ändra ett objekt A1-Cube 1, etc. Röd om den inte uppfyller värdet och grön om den överskrider värdet. Värdet för godkänt/underkänd kan ändras så istället för att ha värdet i VBA:n behöver jag det för att referera till cell A10 som har värdet godkänt/underkänd. Någon chans att någon kan ta fram en exempelkod som jag kan arbeta med.

Tack
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, utmärkt exempel.
Pero como seria si tengo una forma y quiero ir coloreado poco a poco dependiendo del valor emplo:
Si el valor es 50%
Seia mitad roja y mitad verde
Pero que se vaya llenando según el porcentaje vaya aumentando
Klassad 4 av 5
Denna kommentar minimerades av moderatoren på webbplatsen
Como faço para para variar as cores da forma se minha opções för em formato de texto, como "Sim" e "Não"?
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Emilly
För att lösa ditt problem, använd koden nedan:
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A1") = "Yes" Then
ActiveSheet.Shapes("Oval 1").Fill.ForeColor.RGB = vbRed
Else
If Range("A1") = "No" Then
ActiveSheet.Shapes("Oval 1").Fill.ForeColor.RGB = vbGreen
End If
End If
End Sub


Gör ett försök, hoppas det kan hjälpa dig!
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Skyyang,

Jag provade den ursprungliga VBA-koden och fick den att fungera, även om den inte skulle aktiveras aktivt när cellen ändrades. Idag fungerar inte koden och jag provade även din mer förenklade kod och det fungerade fortfarande inte. Det enda som ändrades är att jag kopierade arbetsbladet som innehöll koden som fungerade. Skulle detta då resultera i att det inte fungerar?
Det finns inga kommentarer här ännu
Lämna dina kommentarer
Postar som gäst
×
Betygsätt detta inlägg:
0   Tecken
Föreslagna platser

Följ oss

Copyright © 2009 - www.extendoffice.com. | Alla rättigheter förbehållna. Drivs av ExtendOffice. | | Sitemap
Microsoft och Office-logotypen är varumärken eller registrerade varumärken som tillhör Microsoft Corporation i USA och / eller andra länder.
Skyddad av Sectigo SSL