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

如何在Excel中根據單元格值更改形狀顏色?

基於特定單元格值更改形狀顏色在Excel中可能是一項有趣的任務,例如,如果A1中的單元格值小於100,則形狀顏色為紅色,如果A1大於100且小於200,則形狀顏色為黃色,並且當A1大於200時,形狀顏色為綠色,如下圖所示。 要根據單元格值更改形狀的顏色,本文將為您介紹方法。

doc更改形狀顏色1

使用VBA代碼根據單元格值更改形狀顏色


箭頭藍色右氣泡 使用VBA代碼根據單元格值更改形狀顏色

下面的VBA代碼可以幫助您根據單元格值更改形狀顏色,請執行以下操作:

1。 右鍵單擊要更改形狀顏色的圖紙選項卡,然後選擇 查看代碼 從上下文菜單中,彈出 Microsoft Visual Basic for Applications 窗口,請複制以下代碼並將其粘貼到空白處 模塊 窗口。

VBA代碼:根據單元格值更改形狀顏色:

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更改形狀顏色2

2。 然後,當您在單元格A1中輸入值時,形狀顏色將隨您定義的單元格值而改變。

備註:在上面的代碼中, A1 是您要更改其形狀顏色的單元格值,並且 橢圓形1 是您插入的形狀的形狀名稱,您可以根據需要進行更改。


最佳辦公效率工具

Kutools for Excel 解決了你的大部分問題,並將你的生產力提高了 80%

  • 重用: 快速插入 複雜的公式,圖表 以及您以前使用過的任何東西; 加密單元 帶密碼 創建郵件列表 並發送電子郵件...
  • 超級公式欄 (輕鬆編輯多行文本和公式); 閱讀版式 (輕鬆讀取和編輯大量單元格); 粘貼到過濾範圍...
  • 合併單元格/行/列 不會丟失數據; 拆分單元格內容; 合併重複的行/列...防止細胞重複; 比較範圍...
  • 選擇重複或唯一 行; 選擇空白行 (所有單元格都是空的); 超級查找和模糊查找 在許多工作簿中; 隨機選擇...
  • 確切的副本 多個單元格,無需更改公式參考; 自動創建參考 到多張紙; 插入項目符號,複選框等...
  • 提取文字,添加文本,按位置刪除, 刪除空間; 創建和打印分頁小計; 在單元格內容和註釋之間轉換...
  • 超級濾鏡 (將過濾方案保存並應用於其他工作表); 高級排序 按月/週/日,頻率及更多; 特殊過濾器 用粗體,斜體...
  • 結合工作簿和工作表; 根據關鍵列合併表; 將數據分割成多個工作表; 批量轉換xls,xlsx和PDF...
  • 超過 300 項強大的功能. 支持 Office / Excel 2007-2021 和 365。支持所有語言。 在您的企業或組織中輕鬆部署。 完整功能 30 天免費試用。 60 天退款保證。
kte選項卡201905

Office選項卡為Office帶來了選項卡式界面,使您的工作更加輕鬆

  • 在Word,Excel,PowerPoint中啟用選項卡式編輯和閱讀,發布者,Access,Visio和Project。
  • 在同一窗口的新選項卡中而不是在新窗口中打開並創建多個文檔。
  • 將您的工作效率提高 50%,每天為您減少數百次鼠標點擊!
officetab底部
按評論排序
留言 (21)
4中的5評分 · 1評級
網站主持人對此評論進行了最小化
如果我們在工作表中有超過 1 個對象,其顏色會根據 A1、B1、C1 中輸入的值而變化,例如...
網站主持人對此評論進行了最小化
你好,愛德華,
樂意效勞。 請將以下 VBA 代碼複製並粘貼到空白模塊窗口中。

子TestMacro2()
將 dblHt 調暗為 Double
將 C 調暗為範圍
變暗只要
將 dblMargin 調暗為 Double
調暗SR 只要

lngSR = 2 '數據開始的行

dblMargin = 6 ' 形狀之間的距離

'錯誤繼續下一步
ActiveSheet.Shapes.SelectAll
Selection.Delete
在錯誤轉到0


dblHt = 行數(lngSR). 高度 * 4

For lngr = lngSR To Cells(lngSR, "A").End(xlDown).Row
ActiveSheet.Shapes.AddShape(msoShapeOval,_
單元格(lngSR, "D").Left + ((lngr - lngSR) Mod 4) * dblHt + dblMargin, _
單元格(lngSR, "D").Top + Int((lngr - lngSR) / 4) * dblHt + dblMargin, _
dblHt - 2 * dblMargin,_
dblHt - 2 * dblMargin).選擇
Selection.Name = "Round" & Cells(lngr, "A").Address
選擇.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Cells(lngr, "A").Value
使用 Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignCenter
結束
使用 Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).Font
.Bold = msoTrue
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
大小= 12
結束
使用 Selection.ShapeRange.Fill
.Visible = msoTrue
如果 Cells(lngr, "A").Value > 70 那麼
.ForeColor.RGB = RGB(0, 176, 80)
ElseIf Cells(lngr, "A").Value >= 40 Then
.ForeColor.RGB = RGB(255, 255, 70)
其他
.ForeColor.RGB = RGB(255, 0, 0)
如果結束
.透明度 = 0
。堅硬的
結束
下一個語言
範圍(“A1”)。選擇
END SUB

運行上面的 VBA 代碼後,您會看到生成了多個形狀,並且這些形狀的顏色會根據 VBA 進行更改。
請看我的截圖。 希望它可以提供幫助。 祝你今天過得愉快。
此致,
曼迪
查看附件 (1 / 5)
網站主持人對此評論進行了最小化
我在一張紙上有 300 個形狀。 是否可以檢查工作表中相鄰或鏈接單元格的值(空或非空)並通過 VBA 代碼為鏈接的形狀著色?
網站主持人對此評論進行了最小化
很棒的 vba 解決方案。

也可以使用條件格式為形狀著色。

將每個形狀的名稱設置為單元格值。 使用 With Each Shape 然後將形狀顏色設置為所有命名形狀的單元格顏色。

可以使用基於數值的條件格式更改單元格顏色。

例如,城市地圖上半透明重疊的顏色可用於以圖形方式指示每個街區的人口密度,並採用分級配色方案。
網站主持人對此評論進行了最小化
你能分享一個代碼示例嗎?
網站主持人對此評論進行了最小化
如果您在同一個工作表中有多個形狀,如何應用它?
網站主持人對此評論進行了最小化
你好亞西爾,
樂意效勞。 請將以下 VBA 代碼複製並粘貼到空白模塊窗口中。

子TestMacro2()
將 dblHt 調暗為 Double
將 C 調暗為範圍
變暗只要
將 dblMargin 調暗為 Double
調暗SR 只要

lngSR = 2 '數據開始的行

dblMargin = 6 ' 形狀之間的距離

'錯誤繼續下一步
ActiveSheet.Shapes.SelectAll
Selection.Delete
在錯誤轉到0


dblHt = 行數(lngSR). 高度 * 4

For lngr = lngSR To Cells(lngSR, "A").End(xlDown).Row
ActiveSheet.Shapes.AddShape(msoShapeOval,_
單元格(lngSR, "D").Left + ((lngr - lngSR) Mod 4) * dblHt + dblMargin, _
單元格(lngSR, "D").Top + Int((lngr - lngSR) / 4) * dblHt + dblMargin, _
dblHt - 2 * dblMargin,_
dblHt - 2 * dblMargin).選擇
Selection.Name = "Round" & Cells(lngr, "A").Address
選擇.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Cells(lngr, "A").Value
使用 Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignCenter
結束
使用 Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).Font
.Bold = msoTrue
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
大小= 12
結束
使用 Selection.ShapeRange.Fill
.Visible = msoTrue
如果 Cells(lngr, "A").Value > 70 那麼
.ForeColor.RGB = RGB(0, 176, 80)
ElseIf Cells(lngr, "A").Value >= 40 Then
.ForeColor.RGB = RGB(255, 255, 70)
其他
.ForeColor.RGB = RGB(255, 0, 0)
如果結束
.透明度 = 0
。堅硬的
結束
下一個語言
範圍(“A1”)。選擇
END SUB

運行上面的 VBA 代碼後,您會看到生成了多個形狀,並且這些形狀的顏色會根據 VBA 進行更改。
請看我的截圖。 希望它可以提供幫助。 祝你今天過得愉快。
此致,
曼迪
查看附件 (1 / 5)
網站主持人對此評論進行了最小化
謝謝你,這真的很有用。

我現在想將它與另一個工作表上的數據透視表一起使用,該工作表使用我想要更改顏色的形狀來控制工作表上的數據。 但是,當我更改數據透視表上的選擇時,工作表上帶有形狀的數據會更新,但代碼不會運行,因此形狀不會改變顏色

如果我手動更改代碼運行的值並更新形狀的顏色。

問題:我需要在上面的代碼中添加什麼以使其自動運行?
網站主持人對此評論進行了最小化
如何讓私有子讀取 AVERAGE(C1,C5,C9) 計算的結果?

Sub 僅適用於數值; 非常感謝任何想法和建議。
網站主持人對此評論進行了最小化
你好,切薩雷,你好嗎? 我注意到 VBA 代碼可以使用 AVERAGE(number, number...) 計算。 但訣竅是每次更改計算中的值時,都需要雙擊單元格中的公式才能使 VBA 再次工作。 
例如,在單元格 A1 中,當我們輸入公式 =AVERAGE(C2:D3) 後,VBA 會工作並相應地更改形狀的顏色。 請看截圖1。C0.2:D2,單元格A3的返回結果發生了變化,但形狀顏色還沒有改變。 在這種情況下,我們需要雙擊單元格 A1 中的公式以使 VBA 工作。 然後形狀顏色將相應更改。 請看截圖 1 和 2。
查看附件 (2 / 5)
網站主持人對此評論進行了最小化
嗨...很好的解決方案...但是如何根據一系列單元格的相應值將其應用於多個形狀。 非常感謝您的幫助。
網站主持人對此評論進行了最小化
你好Ryan,
樂意效勞。 請將以下 VBA 代碼複製並粘貼到空白模塊窗口中。

子TestMacro2()
將 dblHt 調暗為 Double
將 C 調暗為範圍
變暗只要
將 dblMargin 調暗為 Double
調暗SR 只要

lngSR = 2 '數據開始的行

dblMargin = 6 ' 形狀之間的距離

'錯誤繼續下一步
ActiveSheet.Shapes.SelectAll
Selection.Delete
在錯誤轉到0


dblHt = 行數(lngSR). 高度 * 4

For lngr = lngSR To Cells(lngSR, "A").End(xlDown).Row
ActiveSheet.Shapes.AddShape(msoShapeOval,_
單元格(lngSR, "D").Left + ((lngr - lngSR) Mod 4) * dblHt + dblMargin, _
單元格(lngSR, "D").Top + Int((lngr - lngSR) / 4) * dblHt + dblMargin, _
dblHt - 2 * dblMargin,_
dblHt - 2 * dblMargin).選擇
Selection.Name = "Round" & Cells(lngr, "A").Address
選擇.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Cells(lngr, "A").Value
使用 Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignCenter
結束
使用 Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).Font
.Bold = msoTrue
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
大小= 12
結束
使用 Selection.ShapeRange.Fill
.Visible = msoTrue
如果 Cells(lngr, "A").Value > 70 那麼
.ForeColor.RGB = RGB(0, 176, 80)
ElseIf Cells(lngr, "A").Value >= 40 Then
.ForeColor.RGB = RGB(255, 255, 70)
其他
.ForeColor.RGB = RGB(255, 0, 0)
如果結束
.透明度 = 0
。堅硬的
結束
下一個語言
範圍(“A1”)。選擇
END SUB

運行上面的 VBA 代碼後,您會看到生成了多個形狀,並且這些形狀的顏色會根據 VBA 進行更改。
請看我的截圖。 希望它可以提供幫助。 祝你今天過得愉快。
此致,
曼迪
查看附件 (1 / 5)
網站主持人對此評論進行了最小化
¿ 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!

網站主持人對此評論進行了最小化
你好瑪麗亞諾埃爾,
樂意效勞。 請將以下 VBA 代碼複製並粘貼到空白模塊窗口中。

子TestMacro2()
將 dblHt 調暗為 Double
將 C 調暗為範圍
變暗只要
將 dblMargin 調暗為 Double
調暗SR 只要

lngSR = 2 '數據開始的行

dblMargin = 6 ' 形狀之間的距離

'錯誤繼續下一步
ActiveSheet.Shapes.SelectAll
Selection.Delete
在錯誤轉到0


dblHt = 行數(lngSR). 高度 * 4

For lngr = lngSR To Cells(lngSR, "A").End(xlDown).Row
ActiveSheet.Shapes.AddShape(msoShapeOval,_
單元格(lngSR, "D").Left + ((lngr - lngSR) Mod 4) * dblHt + dblMargin, _
單元格(lngSR, "D").Top + Int((lngr - lngSR) / 4) * dblHt + dblMargin, _
dblHt - 2 * dblMargin,_
dblHt - 2 * dblMargin).選擇
Selection.Name = "Round" & Cells(lngr, "A").Address
選擇.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Cells(lngr, "A").Value
使用 Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignCenter
結束
使用 Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).Font
.Bold = msoTrue
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
大小= 12
結束
使用 Selection.ShapeRange.Fill
.Visible = msoTrue
如果 Cells(lngr, "A").Value > 70 那麼
.ForeColor.RGB = RGB(0, 176, 80)
ElseIf Cells(lngr, "A").Value >= 40 Then
.ForeColor.RGB = RGB(255, 255, 70)
其他
.ForeColor.RGB = RGB(255, 0, 0)
如果結束
.透明度 = 0
。堅硬的
結束
下一個語言
範圍(“A1”)。選擇
END SUB

運行上面的 VBA 代碼後,您會看到生成了多個形狀,並且這些形狀的顏色會根據 VBA 進行更改。
請看我的截圖。 希望它可以提供幫助。 祝你今天過得愉快。
此致,
曼迪
查看附件 (1 / 5)
網站主持人對此評論進行了最小化
很好的解決方案! 如果工作表中有超過 1 個顏色根據 A1、B1、C1 中輸入的值而變化的橢圓,我該怎麼辦? 提前感謝您的回复! 
網站主持人對此評論進行了最小化
您好 mnsosa,很高興為您提供幫助。 請將以下 VBA 代碼複製並粘貼到空白模塊窗口中。
子TestMacro2()
將 dblHt 調暗為 Double
將 C 調暗為範圍
變暗只要
將 dblMargin 調暗為 Double
調暗SR 只要

lngSR = 2 '數據開始的行

dblMargin = 6 ' 形狀之間的距離

'錯誤繼續下一步
ActiveSheet.Shapes.SelectAll
Selection.Delete
在錯誤轉到0


dblHt = 行數(lngSR). 高度 * 4

For lngr = lngSR To Cells(lngSR, "A").End(xlDown).Row
ActiveSheet.Shapes.AddShape(msoShapeOval,_
單元格(lngSR, "D").Left + ((lngr - lngSR) Mod 4) * dblHt + dblMargin, _
單元格(lngSR, "D").Top + Int((lngr - lngSR) / 4) * dblHt + dblMargin, _
dblHt - 2 * dblMargin,_
dblHt - 2 * dblMargin).選擇
Selection.Name = "Round" & Cells(lngr, "A").Address
選擇.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Cells(lngr, "A").Value
使用 Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignCenter
結束
使用 Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).Font
.Bold = msoTrue
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
大小= 12
結束
使用 Selection.ShapeRange.Fill
.Visible = msoTrue
如果 Cells(lngr, "A").Value > 70 那麼
.ForeColor.RGB = RGB(0, 176, 80)
ElseIf Cells(lngr, "A").Value >= 40 Then
.ForeColor.RGB = RGB(255, 255, 70)
其他
.ForeColor.RGB = RGB(255, 0, 0)
如果結束
.透明度 = 0
。堅硬的
結束
下一個語言
範圍(“A1”)。選擇
END SUB

運行上面的 VBA 代碼後,你會看到生成了多個形狀,這些形狀的顏色根據 VBA 變化。請看我的截圖。 希望它可以提供幫助。 祝你有美好的一天。真誠的,曼迪
查看附件 (1 / 5)
網站主持人對此評論進行了最小化
我是 VBA 的新手,並且正在努力解決一些問題。 我需要 9 個不同的單元格 A1-A9 更改 9 個不同對象的顏色。 對像是立方體 1-9。 澄清一下,每個單元格僅更改一個對象 A1-Cube 1 等。如果不符合該值,則為紅色,如果超過該值,則為綠色。 通過/失敗值可以更改,因此我需要它來引用具有通過/失敗值的單元格 A10 而不是 VBA 中的值。 任何人都可以通過示例代碼供我使用。

謝謝
網站主持人對此評論進行了最小化
Hola, excelente ejemlo。
Pero como seria si tengo una forma y quiero ir coloreado poco a poco dependiendo del valor ejemlo:
價值 50%
Seia mitad roja y mitad verde
Pero que se vaya llenando según el porcentaje vaya aumentando
4中的5評分
網站主持人對此評論進行了最小化
Como faço para para variar as cores da forma se minha opções for em formato de texto, como "Sim" e "Não"?
網站主持人對此評論進行了最小化
你好,艾米麗
要解決您的問題,請應用以下代碼:
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


請試一試,希望對您有所幫助!
網站主持人對此評論進行了最小化
嗨,天陽,

我嘗試了原始的 VBA 代碼並讓它工作,儘管它不會在單元格更改時主動激活。 今天代碼不工作,我也嘗試了你更簡單的代碼,但仍然沒有工作。 唯一改變的是我複制了包含有效代碼的工作表。 這會導致它不起作用嗎?
這裡還沒有評論
留下你的意見
以訪客身份發帖
×
評價此帖子:
0   字符
推薦地點

關注我們

版權所有©2009 - 萬維網。extendoffice.com。 | 版權所有。 供電 ExtendOffice。 |
Microsoft和Office徽標是Microsoft Corporation在美國和/或其他國家的商標或註冊商標。
受Sectigo SSL保護