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

Ինչպե՞ս փոխել ձևի գույնը ՝ հիմնված բջջային արժեքի վրա Excel- ում:

Ձևի գույնի փոփոխումը `ելնելով բջիջների որոշակի արժեքից, կարող է հետաքրքիր խնդիր լինել Excel- ում, օրինակ, եթե A1- ում բջջի արժեքը 100-ից պակաս է, ձևի գույնը կարմիր է, եթե A1- ը 100-ից մեծ է և 200-ից պակաս, ձևի գույնը դեղին է, և երբ A1- ը 200-ից մեծ է, ձևի գույնը կանաչ է, ինչպես ցույց է տրված հետևյալ նկարը: Բջջային արժեքի հիման վրա ձևի գույնը փոխելու համար այս հոդվածը ձեզ համար մեթոդ կներկայացնի:

փաստաթուղթ փոխել ձևի գույնը 1

Փոխեք ձևի գույնը ՝ հիմնվելով բջջային արժեքի վրա, VBA կոդով


նետ կապույտ աջ պղպջակ Փոխեք ձևի գույնը ՝ հիմնվելով բջջային արժեքի վրա, VBA կոդով

Ստորև ներկայացված VBA կոդը կարող է օգնել փոխել ձևի գույնը ՝ ելնելով բջջային արժեքից, խնդրում եմ արեք հետևյալը.

1, Աջ կտտացրեք թերթիկի ներդիրին, որը ցանկանում եք փոխել ձևի գույնը, և այնուհետև ընտրել Դիտել կոդը համատեքստի ընտրացանկից ՝ դուրս եկած պատուհանում Microsoft Visual Basic հավելվածների համար պատուհանը, խնդրում ենք պատճենել և տեղադրեք հետևյալ կոդը դատարկի մեջ Մոդուլներ պատուհան.

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

փաստաթուղթ փոխել ձևի գույնը 2

2, Եվ հետո, երբ A1 բջիջում մուտքագրեք արժեքը, ձևի գույնը կփոխվի ձեր սահմանած բջիջի արժեքի հետ:

ՆշումՎերոհիշյալ ծածկագրում A1 բջիջի արժեքն է, որի հիման վրա կփոխվի ձեր ձևի գույնը, և Օվալ 1 ձեր ներմուծված ձևի ձևի անունն է, դրանք կարող եք փոխել ըստ ձեր կարիքի:


Գրասենյակի արտադրողականության լավագույն գործիքները

Excel-ի համար Kutools-ը լուծում է ձեր խնդիրների մեծ մասը և բարձրացնում ձեր արտադրողականությունը 80%-ով

  • Վերաօգտագործել: Արագ տեղադրեք բարդ բանաձևեր, գծապատկերներ և այն ամենը, ինչ դուք նախկինում օգտագործել եք. Ryածկագրել բջիջները գաղտնաբառով; Ստեղծեք փոստային ցուցակ և նամակներ ուղարկել ...
  • Super Formula Bar (հեշտությամբ խմբագրեք տեքստի և բանաձևի բազմաթիվ տողեր); Ընթերցանության դասավորությունը (հեշտությամբ կարդալ և խմբագրել մեծ թվով բջիջներ); Տեղադրել ֆիլտրացված տիրույթում...
  • Միաձուլել բջիջները / տողերը / սյունակները առանց տվյալների կորստի. Պառակտված բջիջների պարունակությունը; Միավորել կրկնօրինակ տողերը / սյունակները... Կանխել կրկնօրինակ բջիջները; Համեմատեք միջակայքերը...
  • Ընտրեք Կրկնօրինակ կամ Եզակի Շարքեր; Ընտրեք դատարկ շարքեր (բոլոր բջիջները դատարկ են); Super Find և Fuzzy Find շատ աշխատանքային գրքույկներում; Պատահական ընտրություն ...
  • Actշգրիտ պատճեն Բազմաթիվ բջիջներ ՝ առանց բանաձևի հղումը փոխելու; Ավտոմատ ստեղծեք հղումներ դեպի մի քանի թերթեր; Տեղադրեք փամփուշտներ, Տուփեր և ավելին ...
  • Քաղվածք տեքստ, Տեքստ ավելացնել, հեռացնել ըստ դիրքի, Հեռացնել տարածությունը; Ստեղծել և տպել էջային ենթագոտիներ; Փոխարկել բջիջների բովանդակության և մեկնաբանությունների միջև...
  • Սուպեր զտիչ (պահպանել և կիրառել ֆիլտրի սխեմաները այլ թերթերի վրա); Ընդլայնված տեսակավորում ըստ ամիս / շաբաթ / օր, հաճախականություն և ավելին; Հատուկ զտիչ համարձակ, շեղատառով ...
  • Միավորել աշխատանքային տետրերը և աշխատանքային թերթերը; Միավորել աղյուսակները ՝ հիմնված հիմնական սյունակների վրա; Տվյալները բաժանեք մի քանի թերթերի; Խմբաքանակի փոխակերպում xls, xlsx և PDF...
  • Ավելի քան 300 հզոր հատկություններ. Աջակցում է Office / Excel 2007-2021 և 365: Աջակցում է բոլոր լեզուներին: Հեշտ տեղակայում ձեր ձեռնարկությունում կամ կազմակերպությունում: Ամբողջական հնարավորություններ 30-օրյա անվճար փորձարկում: 60-օրյա գումարի վերադարձի երաշխիք:
kte էջանիշը 201905

Office Tab- ը Tabbed ինտերֆեյսը բերում է Office, և ձեր աշխատանքը շատ ավելի դյուրին դարձրեք

  • Միացնել ներդիրներով խմբագրումը և ընթերցումը Word, Excel, PowerPoint- ով, Հրատարակիչ, Access, Visio և Project:
  • Բացեք և ստեղծեք բազմաթիվ փաստաթղթեր նույն պատուհանի նոր ներդիրներում, այլ ոչ թե նոր պատուհաններում:
  • Բարձրացնում է ձեր արտադրողականությունը 50%-ով և նվազեցնում մկնիկի հարյուրավոր սեղմումները ձեզ համար ամեն օր:
officetab ներքևում
Տեսակավորել մեկնաբանությունները ըստ
մեկնաբանություններ (21)
Գնահատված 4- ը 5- ից դուրս է · 1 վարկանիշ
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ի՞նչ կասեք, եթե աշխատաթերթում ունենք 1-ից ավելի օբյեկտ, որի գույները փոխվում են ըստ արժեքի մուտքագրման, ասենք A1, B1, C1...
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Էդվարդ,
Ուրախ եմ օգնել: Խնդրում ենք պատճենել և տեղադրել ստորև ներկայացված VBA կոդը դատարկ մոդուլի պատուհանում:

Sub TestMacro2()
Dim dblHt Որպես կրկնակի
Dim rngC որպես միջակայք
Dim lngr Քանի դեռ
Dim dblMargin որպես կրկնակի
Dim lngSR As Long

lngSR = 2 'Տող, որտեղից սկսվում են տվյալները

dblMargin = 6 ' Ձևերի միջև հեռավորությունը

«Սխալի դեպքում վերսկսել հաջորդը
ActiveSheet.Shapes.SelectAll
Ընտրություն.Ջնջել
Սխալի դեպքում GoTo 0


dblHt = Տողեր (lngSR): Բարձրություն * 4

lngr = lngSR դեպի բջիջներ (lngSR, «A»). Վերջ (xlDown). Տող
ActiveSheet.Shapes.AddShape(msoShapeOval, _
Բջիջներ(lngSR, «D»).Ձախ + ((lngr - lngSR) Mod 4) * dblHt + dblMargin, _
Բջիջներ (lngSR, «D»). Վերև + Int ((lngr - lngSR) / 4) * dblHt + dblՄարգին, _
dblHt - 2 * dblMargin, _
dblHt - 2 * dblMargin).Ընտրեք
Selection.Name = "Round" & Cells (lngr, "A"): Հասցե
Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Cells(lngr, «A»).Արժեք
Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2):ParagraphFormat.
.FirstLineIndent = 0
.Հավասարեցում = msoAlignCenter
Վերջ
Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1)Տառատեսակով
Համարձակ = msoTrue
.Լրացնել.Տեսանելի = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Լրացնել.Թափանցիկություն = 0
.Լրացնել.Պինդ
.Չափ = 12
Վերջ
Selection.ShapeRange.Fill-ով
Տեսանելի = msoTrue
If Cells (lngr, «A»). Արժեք > 70 Այնուհետեւ
.ForeColor.RGB = RGB(0, 176, 80)
ElseIf Cells(lngr, «A»): Արժեք >= 40 Հետո
.ForeColor.RGB = RGB(255, 255, 70)
Ուրիշ
.ForeColor.RGB = RGB(255, 0, 0)
Վերջ: Եթե
.Թափանցիկություն = 0
.Պինդ
Վերջ
Հաջորդ lngr
Շրջանակ («A1»): Ընտրեք
Վերջ Sub

Վերևում VBA ծածկագիրը գործարկելուց հետո կտեսնեք, որ ստեղծվում են բազմաթիվ ձևեր, և այդ ձևերի գույները փոխվում են ըստ VBA-ի:
Խնդրում եմ տեսեք իմ սքրինշոթը: Հուսով եմ, որ դա կարող է օգնել: Հաճելի օր.
Sincerely,
Mandy
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ես ունեմ 300 ձև մի թերթիկի մեջ: Հնարավո՞ր է արդյոք ստուգել հարակից կամ կապակցված բջիջի արժեքը (դատարկ կամ ոչ դատարկ) թերթիկում և գունավորել կապակցված ձևերը VBA կոդի միջոցով:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
VBA-ի հիանալի լուծում.

Հնարավոր է նաև օգտագործել պայմանական ֆորմատավորում՝ ձևերը գունավորելու համար։

Սահմանեք յուրաքանչյուր ձևի անունը որպես բջիջի արժեք: Օգտագործելով «Յուրաքանչյուր ձևով», այնուհետև ձևի գույնը սահմանեք որպես բջիջի գույն բոլոր անվանված ձևերի համար:

Բջջի գույնը կարող է փոխվել թվային արժեքների վրա հիմնված պայմանական ձևաչափման միջոցով:

Օրինակ՝ քաղաքի քարտեզի վրա կիսաթափանցիկ համընկնման գույնը կարող է օգտագործվել՝ գրաֆիկականորեն ցույց տալու բնակչության խտությունը մեկ բլոկի վրա՝ աստիճանական գունային սխեմայով:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Կարող եք կիսվել կոդի օրինակով:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ինչպե՞ս կարող է դա կիրառվել, եթե միևնույն աշխատաթերթում ունեք մի քանի ձև:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Յասիր,
Ուրախ եմ օգնել: Խնդրում ենք պատճենել և տեղադրել ստորև ներկայացված VBA կոդը դատարկ մոդուլի պատուհանում:

Sub TestMacro2()
Dim dblHt Որպես կրկնակի
Dim rngC որպես միջակայք
Dim lngr Քանի դեռ
Dim dblMargin որպես կրկնակի
Dim lngSR As Long

lngSR = 2 'Տող, որտեղից սկսվում են տվյալները

dblMargin = 6 ' Ձևերի միջև հեռավորությունը

«Սխալի դեպքում վերսկսել հաջորդը
ActiveSheet.Shapes.SelectAll
Ընտրություն.Ջնջել
Սխալի դեպքում GoTo 0


dblHt = Տողեր (lngSR): Բարձրություն * 4

lngr = lngSR դեպի բջիջներ (lngSR, «A»). Վերջ (xlDown). Տող
ActiveSheet.Shapes.AddShape(msoShapeOval, _
Բջիջներ(lngSR, «D»).Ձախ + ((lngr - lngSR) Mod 4) * dblHt + dblMargin, _
Բջիջներ (lngSR, «D»). Վերև + Int ((lngr - lngSR) / 4) * dblHt + dblՄարգին, _
dblHt - 2 * dblMargin, _
dblHt - 2 * dblMargin).Ընտրեք
Selection.Name = "Round" & Cells (lngr, "A"): Հասցե
Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Cells(lngr, «A»).Արժեք
Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2):ParagraphFormat.
.FirstLineIndent = 0
.Հավասարեցում = msoAlignCenter
Վերջ
Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1)Տառատեսակով
Համարձակ = msoTrue
.Լրացնել.Տեսանելի = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Լրացնել.Թափանցիկություն = 0
.Լրացնել.Պինդ
.Չափ = 12
Վերջ
Selection.ShapeRange.Fill-ով
Տեսանելի = msoTrue
If Cells (lngr, «A»). Արժեք > 70 Այնուհետեւ
.ForeColor.RGB = RGB(0, 176, 80)
ElseIf Cells(lngr, «A»): Արժեք >= 40 Հետո
.ForeColor.RGB = RGB(255, 255, 70)
Ուրիշ
.ForeColor.RGB = RGB(255, 0, 0)
Վերջ: Եթե
.Թափանցիկություն = 0
.Պինդ
Վերջ
Հաջորդ lngr
Շրջանակ («A1»): Ընտրեք
Վերջ Sub

Վերևում VBA ծածկագիրը գործարկելուց հետո կտեսնեք, որ ստեղծվում են բազմաթիվ ձևեր, և այդ ձևերի գույները փոխվում են ըստ VBA-ի:
Խնդրում եմ տեսեք իմ սքրինշոթը: Հուսով եմ, որ դա կարող է օգնել: Հաճելի օր.
Sincerely,
Mandy
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Շնորհակալություն դրա համար, որն իսկապես օգտակար է:

Այժմ ես ուզում եմ օգտագործել այն մեկ այլ աշխատաթերթի առանցքային աղյուսակի հետ, որը վերահսկում է թերթի տվյալները այն ձևերով, որոնք ես ուզում եմ փոխել գույնը: Այնուամենայնիվ, երբ ես փոխում եմ ընտրությունը առանցքային աղյուսակի վրա, ձևերով աշխատաթերթի տվյալները թարմացվում են, բայց կոդը չի աշխատում, որպեսզի ձևերը չփոխեն գույնը:

Եթե ​​ես ձեռքով փոխեմ արժեքները, կոդն աշխատում է, և ձևերի գույնը թարմացվում է:

Հարց. ի՞նչ պետք է ավելացնեմ վերը նշված կոդի մեջ, որպեսզի այն ինքնաբերաբար աշխատի:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ինչպե՞ս կարող եմ մասնավոր ենթակետը կարդալ AVERAGE (C1, C5, C9) հաշվարկի արդյունքը:

Sub-ն աշխատում է միայն թվային արժեքներով; ցանկացած մտքեր և առաջարկություններ մեծապես գնահատվում են:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Չեզարե, ինչպե՞ս ես: Նկատում եմ, որ VBA կոդը կարող է աշխատել AVERAGE (համար, համար...) հաշվարկով։ Բայց հնարքն այն է, որ ամեն անգամ, երբ դուք փոխում եք հաշվարկի արժեքները, դուք պետք է կրկնակի սեղմեք բանաձևի վրա բջիջում, որպեսզի VBA-ն նորից աշխատի: 
Օրինակ՝ A1 բջիջում բանաձևը = AVERAGE (C2:D3) մուտքագրելուց հետո VBA-ն աշխատում է և համապատասխանաբար փոխում է ձևի գույնը: Խնդրում ենք տեսնել սքրինշոթ 1. C0.2:D2, A3 բջիջում վերադարձված արդյունքը փոխվում է, բայց ձևի գույնը դեռ չի փոխվել: Այս դեպքում մենք պետք է կրկնակի սեղմենք բանաձևը A1 բջիջում, որպեսզի VBA-ն աշխատի: Այնուհետև ձևի գույնը կփոխվի համապատասխանաբար: Խնդրում ենք տեսնել սքրինշոթները 1 և 2:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջույն... հիանալի լուծում... բայց ինչպես կարող եմ այն ​​կիրառել մի քանի ձևերի վրա՝ հիմնվելով մի շարք բջիջների համապատասխան արժեքների վրա: Կանխավ շատ շնորհակալություն ձեր օգնության համար:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Ռայան
Ուրախ եմ օգնել: Խնդրում ենք պատճենել և տեղադրել ստորև ներկայացված VBA կոդը դատարկ մոդուլի պատուհանում:

Sub TestMacro2()
Dim dblHt Որպես կրկնակի
Dim rngC որպես միջակայք
Dim lngr Քանի դեռ
Dim dblMargin որպես կրկնակի
Dim lngSR As Long

lngSR = 2 'Տող, որտեղից սկսվում են տվյալները

dblMargin = 6 ' Ձևերի միջև հեռավորությունը

«Սխալի դեպքում վերսկսել հաջորդը
ActiveSheet.Shapes.SelectAll
Ընտրություն.Ջնջել
Սխալի դեպքում GoTo 0


dblHt = Տողեր (lngSR): Բարձրություն * 4

lngr = lngSR դեպի բջիջներ (lngSR, «A»). Վերջ (xlDown). Տող
ActiveSheet.Shapes.AddShape(msoShapeOval, _
Բջիջներ(lngSR, «D»).Ձախ + ((lngr - lngSR) Mod 4) * dblHt + dblMargin, _
Բջիջներ (lngSR, «D»). Վերև + Int ((lngr - lngSR) / 4) * dblHt + dblՄարգին, _
dblHt - 2 * dblMargin, _
dblHt - 2 * dblMargin).Ընտրեք
Selection.Name = "Round" & Cells (lngr, "A"): Հասցե
Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Cells(lngr, «A»).Արժեք
Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2):ParagraphFormat.
.FirstLineIndent = 0
.Հավասարեցում = msoAlignCenter
Վերջ
Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1)Տառատեսակով
Համարձակ = msoTrue
.Լրացնել.Տեսանելի = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Լրացնել.Թափանցիկություն = 0
.Լրացնել.Պինդ
.Չափ = 12
Վերջ
Selection.ShapeRange.Fill-ով
Տեսանելի = msoTrue
If Cells (lngr, «A»). Արժեք > 70 Այնուհետեւ
.ForeColor.RGB = RGB(0, 176, 80)
ElseIf Cells(lngr, «A»): Արժեք >= 40 Հետո
.ForeColor.RGB = RGB(255, 255, 70)
Ուրիշ
.ForeColor.RGB = RGB(255, 0, 0)
Վերջ: Եթե
.Թափանցիկություն = 0
.Պինդ
Վերջ
Հաջորդ lngr
Շրջանակ («A1»): Ընտրեք
Վերջ Sub

Վերևում VBA ծածկագիրը գործարկելուց հետո կտեսնեք, որ ստեղծվում են բազմաթիվ ձևեր, և այդ ձևերի գույները փոխվում են ըստ VBA-ի:
Խնդրում եմ տեսեք իմ սքրինշոթը: Հուսով եմ, որ դա կարող է օգնել: Հաճելի օր.
Sincerely,
Mandy
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
¿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 կոդը դատարկ մոդուլի պատուհանում:

Sub TestMacro2()
Dim dblHt Որպես կրկնակի
Dim rngC որպես միջակայք
Dim lngr Քանի դեռ
Dim dblMargin որպես կրկնակի
Dim lngSR As Long

lngSR = 2 'Տող, որտեղից սկսվում են տվյալները

dblMargin = 6 ' Ձևերի միջև հեռավորությունը

«Սխալի դեպքում վերսկսել հաջորդը
ActiveSheet.Shapes.SelectAll
Ընտրություն.Ջնջել
Սխալի դեպքում GoTo 0


dblHt = Տողեր (lngSR): Բարձրություն * 4

lngr = lngSR դեպի բջիջներ (lngSR, «A»). Վերջ (xlDown). Տող
ActiveSheet.Shapes.AddShape(msoShapeOval, _
Բջիջներ(lngSR, «D»).Ձախ + ((lngr - lngSR) Mod 4) * dblHt + dblMargin, _
Բջիջներ (lngSR, «D»). Վերև + Int ((lngr - lngSR) / 4) * dblHt + dblՄարգին, _
dblHt - 2 * dblMargin, _
dblHt - 2 * dblMargin).Ընտրեք
Selection.Name = "Round" & Cells (lngr, "A"): Հասցե
Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Cells(lngr, «A»).Արժեք
Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2):ParagraphFormat.
.FirstLineIndent = 0
.Հավասարեցում = msoAlignCenter
Վերջ
Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1)Տառատեսակով
Համարձակ = msoTrue
.Լրացնել.Տեսանելի = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Լրացնել.Թափանցիկություն = 0
.Լրացնել.Պինդ
.Չափ = 12
Վերջ
Selection.ShapeRange.Fill-ով
Տեսանելի = msoTrue
If Cells (lngr, «A»). Արժեք > 70 Այնուհետեւ
.ForeColor.RGB = RGB(0, 176, 80)
ElseIf Cells(lngr, «A»): Արժեք >= 40 Հետո
.ForeColor.RGB = RGB(255, 255, 70)
Ուրիշ
.ForeColor.RGB = RGB(255, 0, 0)
Վերջ: Եթե
.Թափանցիկություն = 0
.Պինդ
Վերջ
Հաջորդ lngr
Շրջանակ («A1»): Ընտրեք
Վերջ Sub

Վերևում VBA ծածկագիրը գործարկելուց հետո կտեսնեք, որ ստեղծվում են բազմաթիվ ձևեր, և այդ ձևերի գույները փոխվում են ըստ VBA-ի:
Խնդրում եմ տեսեք իմ սքրինշոթը: Հուսով եմ, որ դա կարող է օգնել: Հաճելի օր.
Sincerely,
Mandy
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Հիանալի լուծում! Ինչպե՞ս կարող եմ անել, եթե աշխատանքային թերթիկում ունեմ 1-ից ավելի օվալ, որի գույները փոխվում են ըստ մուտքագրված արժեքի, ասենք A1, B1, C1: Նախապես շնորհակալություն ձեր պատասխանի համար: 
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջույն mnsosa, ուրախ եմ օգնել: Խնդրում ենք պատճենել և տեղադրել ստորև ներկայացված VBA կոդը դատարկ մոդուլի պատուհանում:
Sub TestMacro2()
Dim dblHt Որպես կրկնակի
Dim rngC որպես միջակայք
Dim lngr Քանի դեռ
Dim dblMargin որպես կրկնակի
Dim lngSR As Long

lngSR = 2 'Տող, որտեղից սկսվում են տվյալները

dblMargin = 6 ' Ձևերի միջև հեռավորությունը

«Սխալի դեպքում վերսկսել հաջորդը
ActiveSheet.Shapes.SelectAll
Ընտրություն.Ջնջել
Սխալի դեպքում GoTo 0


dblHt = Տողեր (lngSR): Բարձրություն * 4

lngr = lngSR դեպի բջիջներ (lngSR, «A»). Վերջ (xlDown). Տող
ActiveSheet.Shapes.AddShape(msoShapeOval, _
Բջիջներ(lngSR, «D»).Ձախ + ((lngr - lngSR) Mod 4) * dblHt + dblMargin, _
Բջիջներ (lngSR, «D»). Վերև + Int ((lngr - lngSR) / 4) * dblHt + dblՄարգին, _
dblHt - 2 * dblMargin, _
dblHt - 2 * dblMargin).Ընտրեք
Selection.Name = "Round" & Cells (lngr, "A"): Հասցե
Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Cells(lngr, «A»).Արժեք
Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2):ParagraphFormat.
.FirstLineIndent = 0
.Հավասարեցում = msoAlignCenter
Վերջ
Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1)Տառատեսակով
Համարձակ = msoTrue
.Լրացնել.Տեսանելի = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Լրացնել.Թափանցիկություն = 0
.Լրացնել.Պինդ
.Չափ = 12
Վերջ
Selection.ShapeRange.Fill-ով
Տեսանելի = msoTrue
If Cells (lngr, «A»). Արժեք > 70 Այնուհետեւ
.ForeColor.RGB = RGB(0, 176, 80)
ElseIf Cells(lngr, «A»): Արժեք >= 40 Հետո
.ForeColor.RGB = RGB(255, 255, 70)
Ուրիշ
.ForeColor.RGB = RGB(255, 0, 0)
Վերջ: Եթե
.Թափանցիկություն = 0
.Պինդ
Վերջ
Հաջորդ lngr
Շրջանակ («A1»): Ընտրեք
Վերջ Sub

Վերևում VBA ծածկագիրը գործարկելուց հետո կտեսնեք, որ մի քանի ձևեր են ստեղծվում, և այս ձևերի գույները փոխվում են՝ համաձայն VBA-ի: Խնդրում ենք տեսնել իմ սքրինշոթը: Հուսով եմ, որ դա կարող է օգնել: Բարի օր: Հարգանքներով, Մենդի
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ես նոր եմ VBA-ներում և ինչ-որ բանի հետ եմ պայքարում: Ինձ պետք է ունենալ 9 տարբեր բջիջ A1-A9, որոնք փոխում են 9 տարբեր առարկաների գույնը: Օբյեկտները 1-9 խորանարդներ են: Պարզապես պարզաբանելու համար, յուրաքանչյուր բջիջ պետք է փոխի ընդամենը մեկ օբյեկտ A1-Cube 1 և այլն: Կարմիրը, եթե այն չի համապատասխանում արժեքին, և կանաչը, եթե այն գերազանցում է արժեքը: Անցնել/անհաջող արժեքը կարող է փոխվել, ուստի VBA-ում արժեք ունենալու փոխարեն այն պետք է հղում կատարի A10 բջիջին, որն ունի անցում/անհաջող արժեք: Ցանկացած հնարավորություն, որ ինչ-որ մեկը կարող է ինձ համար աշխատել օրինակելի ծածկագրի միջոցով:

Շնորհակալություն
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Հոլա, հիանալի օրինակ:
Pero como seria si tengo una forma y quiero ir coloreado poco a poco dependiendo del valor ejemplo:
Քաջություն է 50%
Սեյա միտադ րովա և միտադ վերդե
Pero que se vaya llenando según el porcentaje vaya aumentando
Գնահատված 4- ը 5- ից դուրս է
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Como faço para variar as cores da forma se minha opções for em formato de texto, como «Sim» և «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 - www.extendoffice.com. | Բոլոր իրավունքները պաշտպանված են. Powered by ExtendOffice. | | Կայքի քարտեզ
Microsoft- ը և Office- ի պատկերանշանը հանդիսանում են Microsoft Corporation- ի ապրանքային նշաններ կամ գրանցված ապրանքային նշաններ ԱՄՆ-ում և (կամ) այլ երկրներում:
Պաշտպանված է Sectigo SSL- ի կողմից