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

Sut i newid maint siâp yn awtomatig yn seiliedig / dibynnu ar werth celloedd penodedig yn Excel?

Os ydych chi am newid maint siâp yn awtomatig yn seiliedig ar werth cell benodol, gall yr erthygl hon eich helpu chi.

Newid maint siâp awto yn seiliedig ar werth celloedd penodedig gyda chod VBA


Newid maint siâp awto yn seiliedig ar werth celloedd penodedig gyda chod VBA


Gall y cod VBA canlynol eich helpu i newid maint siâp penodol yn seiliedig ar werth celloedd penodedig yn y daflen waith gyfredol. Gwnewch fel a ganlyn.

1. De-gliciwch y tab dalen gyda siâp sydd ei angen arnoch i newid maint, ac yna cliciwch Gweld y Cod o'r ddewislen clicio ar y dde.

2. Yn y Microsoft Visual Basic ar gyfer Ceisiadau ffenestr, copïo a gludo'r cod VBA canlynol i mewn i ffenestr y Cod.

Cod VBA: Maint siâp newid awto yn seiliedig ar werth celloedd penodedig yn Excel

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Row = 2 And Target.Column = 1 Then
        Call SizeCircle("Oval 2", Val(Target.Value))
    End If
End Sub
Sub SizeCircle(Name As String, Diameter)
    Dim xCenterX As Single
    Dim xCenterY As Single
    Dim xCircle As Shape
    Dim xDiameter As Single
    On Error GoTo ExitSub
    xDiameter = Diameter
    If xDiameter > 10 Then xDiameter = 10
    If xDiameter < 1 Then xDiameter = 1
    Set xCircle = ActiveSheet.Shapes(Name)
    With xCircle
        xCenterX = .Left + (.Width / 2)
        xCenterY = .Top + (.Height / 2)
        .Width = Application.CentimetersToPoints(xDiameter)
        .Height = Application.CentimetersToPoints(xDiameter)
        .Left = xCenterX - (.Width / 2)
        .Top = xCenterY - (.Height / 2)
    End With
ExitSub:
End Sub

Nodyn: Yn y cod, “2 Oval”Yw'r enw siâp y byddwch chi'n newid ei faint. Ac Rhes = 2, Colofn = 1 yn golygu y bydd maint siâp “Oval 2” yn cael ei newid gyda'r gwerth yn A2. Newidiwch nhw yn ôl yr angen.

Ar gyfer newid maint siapiau lluosog yn seiliedig ar wahanol werthoedd celloedd, cymhwyswch y cod VBA isod.

Cod VBA: Ailfeintiwch siapiau lluosog yn seiliedig ar werth gwahanol gelloedd penodol yn Excel

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xAddress As String
    On Error Resume Next
    If Target.CountLarge = 1 Then
        xAddress = Target.Address(0, 0)
        If xAddress = "A1" Then
            Call SizeCircle("Oval 1", Val(Target.Value))
        ElseIf xAddress = "A2" Then
            Call SizeCircle("Smiley Face 3", Val(Target.Value))
        ElseIf xAddress = "A3" Then
            Call SizeCircle("Heart 2", Val(Target.Value))
        End If
    End If
End Sub

Sub SizeCircle(Name As String, Diameter)
    Dim xCenterX As Single
    Dim xCenterY As Single
    Dim xCircle As Shape
    Dim xDiameter As Single
    On Error GoTo ExitSub
    xDiameter = Diameter
    If xDiameter > 10 Then xDiameter = 10
    If xDiameter < 1 Then xDiameter = 1
    Set xCircle = ActiveSheet.Shapes(Name)
    With xCircle
        xCenterX = .Left + (.Width / 2)
        xCenterY = .Top + (.Height / 2)
        .Width = Application.CentimetersToPoints(xDiameter)
        .Height = Application.CentimetersToPoints(xDiameter)
        .Left = xCenterX - (.Width / 2)
        .Top = xCenterY - (.Height / 2)
    End With
ExitSub:
End Sub

Nodiadau:

1) Yn y cod, “1 Oval","Wyneb Smiley 3"A"Calon 3”Yw enw'r siapiau y byddwch chi'n newid eu maint yn awtomatig. Ac A1, A2 acA3 yw'r celloedd sy'n gwerthfawrogi maint y byddwch chi'n newid maint siapiau yn seiliedig arnynt.
2) Os ydych chi am ychwanegu mwy o siapiau, ychwanegwch linellau "ElseIf xAddress = "A3" Yna"ac "Ffoniwch SizeCircle (" Calon 2 ", Val (Target.Value))"uwchlaw'r cyntaf"Gorffennwch Os"llinell yn y cod. A newid cyfeiriad y gell ac enw siâp yn seiliedig ar eich anghenion.

3. Gwasgwch Alt + Q allweddi ar yr un pryd i gau'r Microsoft Visual Basic ar gyfer Ceisiadau ffenestr.

O hyn ymlaen, pan fyddwch chi'n newid y gwerth yng nghell A2, bydd maint siâp Oval 2 yn cael ei newid yn awtomatig. Gweler y screenshot:

Neu newidiwch y gwerthoedd yng nghell A1, A2 ac A3 i newid maint y siapiau cyfatebol "Oval 1", "Smiley Face 3" a "Heart 3" yn awtomatig. Gweler y screenshot:

Nodyn: Ni fydd maint y siâp yn newid mwyach pan fydd gwerth y gell yn fwy na 10.


Rhestrwch ac allforiwch bob siâp yn llyfr gwaith Excel cyfredol:

Mae Graffeg Allforio cyfleustodau Kutools ar gyfer Excel eich helpu i restru'r holl siapiau yn y llyfr gwaith cyfredol yn gyflym, a gallwch eu hallforio i gyd i ffolder benodol ar unwaith wrth i'r screenshot isod shwon. Dadlwythwch a rhowch gynnig arni nawr! (llwybr 30 diwrnod am ddim)


Erthyglau cysylltiedig:


Yr Offer Cynhyrchedd Swyddfa Gorau

Mae Kutools for Excel yn Datrys y rhan fwyaf o'ch Problemau, ac yn Cynyddu Eich Cynhyrchedd 80%

  • Ailddefnyddio: Mewnosod yn gyflym fformwlâu cymhleth, siartiau ac unrhyw beth rydych chi wedi'i ddefnyddio o'r blaen; Amgryptio Celloedd gyda chyfrinair; Creu Rhestr Bostio ac anfon e-byst ...
  • Bar Fformiwla Gwych (golygu llinellau lluosog o destun a fformiwla yn hawdd); Cynllun Darllen (darllen a golygu nifer fawr o gelloedd yn hawdd); Gludo i'r Ystod Hidlo...
  • Uno Celloedd / Rhesi / Colofnau heb golli Data; Cynnwys Celloedd Hollt; Cyfuno Rhesi / Colofnau Dyblyg... Atal Celloedd Dyblyg; Cymharwch y Meysydd...
  • Dewiswch Dyblyg neu Unigryw Rhesi; Dewiswch Blank Rows (mae pob cell yn wag); Darganfyddiad Gwych a Darganfyddiad Niwlog mewn Llawer o Lyfrau Gwaith; Dewis ar Hap ...
  • Copi Union Celloedd Lluosog heb newid cyfeirnod fformiwla; Auto Creu Cyfeiriadau i Daflenni Lluosog; Mewnosod Bwledi, Blychau Gwirio a mwy ...
  • Testun Detholiad, Ychwanegu Testun, Tynnu yn ôl Swydd, Tynnwch y Gofod; Creu ac Argraffu Subtotals Paging; Trosi rhwng Cynnwys a Sylwadau Celloedd...
  • Hidlo Super (arbed a chymhwyso cynlluniau hidlo i ddalenni eraill); Trefnu Uwch yn ôl mis / wythnos / dydd, amlder a mwy; Hidlo Arbennig gan feiddgar, italig ...
  • Cyfuno Llyfrau Gwaith a Thaflenni Gwaith; Uno Tablau yn seiliedig ar golofnau allweddol; Rhannwch Ddata yn Daflenni Lluosog; Trosi Swp xls, xlsx a PDF...
  • Mwy na 300 o nodweddion pwerus. Yn cefnogi Swyddfa / Excel 2007-2019 a 365. Yn cefnogi pob iaith. Defnydd hawdd yn eich menter neu sefydliad. Nodweddion llawn treial am ddim 30 diwrnod. Gwarant arian yn ôl 60 diwrnod.
tab kte 201905

Mae Tab Office yn Dod â rhyngwyneb Tabbed i'r Swyddfa, a Gwneud Eich Gwaith yn Haws o lawer

  • Galluogi golygu a darllen tabbed yn Word, Excel, PowerPoint, Cyhoeddwr, Mynediad, Visio a Phrosiect.
  • Agor a chreu dogfennau lluosog mewn tabiau newydd o'r un ffenestr, yn hytrach nag mewn ffenestri newydd.
  • Yn cynyddu eich cynhyrchiant 50%, ac yn lleihau cannoedd o gliciau llygoden i chi bob dydd!
gwaelod officetab
sylwadau (16)
Dim sgôr eto. Byddwch y cyntaf i sgorio!
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Sut fyddech chi'n gweithredu hyn gyda siapiau lluosog, pob un yn dibynnu ar wahanol gelloedd?
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Annwyl Jade,
Mae'r erthygl yn cael ei diweddaru gydag adran cod newydd a all eich helpu i weithredu gyda siapiau lluosog, pob un yn dibynnu ar wahanol gelloedd. Diolch i chi am eich sylw.

Best Regards,
Crystal
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Sut ydw i'n enwi fy siâp? Yn eich enghraifft uchod, sut ydych chi'n rhoi'r enw Oval 2 i'r cylch rydych chi wedi'i dynnu?
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Annwyl Ranjit,
Ar gyfer enwi siâp, dewiswch y siâp hwn, rhowch enw'r siâp yn y Blwch Enw, ac yna pwyswch y fysell Enter. Gweler y llun isod.
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, sut ydw i'n ailadrodd yr un peth ar gyfer siapiau lluosog sy'n gysylltiedig â chelloedd lluosog yn yr un modiwl?
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Annwyl Abhinaya,
Mae'r erthygl yn cael ei diweddaru gydag adran cod newydd a all eich helpu i weithredu gyda siapiau lluosog, pob un yn dibynnu ar wahanol gelloedd. Diolch i chi am eich sylw.

Best Regards,
Crystal
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Heia,
Rwyf wedi ceisio defnyddio'ch post i ysgrifennu fy nghod VBA fy hun ond nid yw'n ymddangos fy mod yn mynd yn bell iawn. Yn bennaf oherwydd dydw i ddim wir yn deall VBA ac rwy'n ceisio addasu'ch un chi. Roeddwn i'n meddwl tybed a allech chi helpu. Rydw i eisiau newid hyd petryal yn dibynnu ar y gwerth mewn cell. Hoffwn i'r lled os yw'r petryal yn aros yr un peth ond y hyd i newid. Hoffwn i'r ddau fertig llaw chwith aros yn yr un lle ac iddo ymestyn i'r dde. Ydy hyn yn bosibl?
Diolch yn fawr
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Annwyl lan,
Gobeithio y gall y cod VBA canlynol ddatrys eich problem. (Amnewidiwch yr Oval 1 gyda'ch enw siâp eich hun)

Is-daflen Waith Breifat_Newid(Targed ByVal Fel Ystod)
Ar Ail-ddechrau Gwall Nesaf
Os yw Target.Row = 2 A Target.Column = 1 Yna
Ffoniwch SizeCircle ("Oval 1", Val (Target.Value))
Gorffennwch Os
Is-End
Cylch Is Maint (Enw Fel Llinyn, Diamedr)
Dim x Cylch fel Siâp
Dim xDiamedr Fel Sengl
Ar Gwall Ewch i ExitSub
xDiameter = Diamedr
Os yw xDiameter > 10 Yna xDiameter = 10
Os yw xDiameter < 1 Yna xDiameter = 1
Gosod xCircle = ActiveSheet.Shapes(Name)
xCylch.Graddfa Lled 1.5, msoFalse, msoScaleFromTopLeft
Gyda xCylch
.LockAspectRatio = msoFalse
.Width = Cais.CentimetersToPoints(xDiameter)
Diwedd Gyda
ExitSub:
Is-End
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, a oes unrhyw ffordd y gallaf wneud i'r siâp ehangu ar ddau ddimensiwn (yn hytrach na chynyddu maint y siâp 5, ei gynyddu 5 ar y llorweddol a 3 ar y fertigol)?
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Annwyl Sam,
Gall y sgript VBA ganlynol eich helpu i ddatrys y broblem. A'r ddau ddimensiwn yw cell A1 a B1.

Is-daflen Waith Breifat_Newid(Targed ByVal Fel Ystod)
Ar Ail-ddechrau Gwall Nesaf
Os yw Target.Count = 1 Yna
Os Ddim yn Croestorri (Targed, Ystod ("A1:B1")) Yn Dim Yna
Ffoniwch SizeCircle ("Oval 2", Array(Gwerth(Amrediad("A1").Gwerth), Val(Amrediad("B1").Gwerth))))
Gorffennwch Os
Gorffennwch Os
Is-End
Cylch Is Maint (Enw Fel Llinynnol, Arr Fel Amrywiad)
Dim I Cyn Hir
Dim xCenterX Fel Sengl
Dim xCanolfan Fel Sengl
Dim x Cylch fel Siâp
Ar Gwall Ewch i ExitSub
Ar gyfer I = 0 I UBound(Arr)
Os Arr(I) > 10 Yna
Arr(I) = 10
ArallOs Arr(I) < 1 Yna
Arr(I) = 1
Gorffennwch Os
Digwyddiadau
Gosod xCircle = ActiveSheet.Shapes(Name)
Gyda xCylch
xCenterX = .Chwith + (.Width/2)
xCenterY = .Top + (. Uchder / 2)
.Width = Cais.CentimetersToPoints(Arr(0))
.Uchder = Cais.CentimetersToPoints(Arr(1))
.Chwith = xCenterX - (.Width / 2)
.Top = xCenterY - (. Uchder / 2)
Diwedd Gyda
ExitSub:
Is-End
Lleihawyd y sylw hwn gan y safonwr ar y wefan
A oes ffordd i wneud hyn gyda Delweddau? Nid yw'n ymddangos fy mod yn cael unrhyw lwc gan ddefnyddio'r cod fel y'i postiwyd.

5 Delwedd mewn bwrdd arweinwyr, rwyf am i'r Delweddau yn 1af neu wedi'u clymu ar gyfer 1af fod yn fwy. Felly mae gen i 2 faint delwedd sefydlog, naill ai 1x2 am ddim yn gyntaf neu 2x4 ar gyfer y safle 1af (er enghraifft). Mae gen i safle wedi'i osod yn barod felly gallaf ddefnyddio hwnnw i greu meintiau mewn celloedd penodol ar gyfer pob delwedd (hy defnyddio datganiad IF felly OS RANK yw maint 1af lled yw 2). Mae fy VBA yn eithaf gwan serch hynny.

Yn y bôn rydw i eisiau - ar ddiweddariad taflen - edrych ar gelloedd maint delwedd a gosod pob maint delwedd i ganlyniad celloedd maint delwedd penodol. Ni allaf weld yn y VBA uchod sut mae hynny'n union yn gweithio ond rwy'n meddwl y dylai fod yn hawdd!
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo Crytal,

Hoffwn ofyn i chi os oes ffordd i ddewis lliw ( cell goch = ffurf goch ) ac enw o gelloedd penodol . a allai hefyd fod yn bosibl creu ffurflenni yn awtomatig o VBA?

Diolch yn fawr o flaen llaw :)

Carol
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo Crytal
beth os i benderfynu ar ochr y ciwb, triongl, blwch y mae'n rhaid ei benderfynu yn seiliedig ar hyd, lled? Helpwch fi os gwelwch yn dda

Diolch
cadair
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo Chairil,
Mae'n ddrwg gennym ni all eich helpu gyda hynny eto. Diolch am eich sylw.
Lleihawyd y sylw hwn gan y safonwr ar y wefan
a oes ffordd i hyn weithio os yw'r gell rydych chi'n ei defnyddio i osod y maint yn ganlyniad fformiwla yn hytrach na dim ond gwerth statig rydych chi'n ei nodi â llaw?
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo mathnz, Gall y cod VBA isod eich helpu i ddatrys y broblem. Y cyfan sydd angen i chi ei wneud yw newid y celloedd gwerth a'r enwau siâp yn y cod yn seiliedig ar eich data eich hun.
Is-daflen Waith Breifat_Cyfrifo()
'Diweddarwyd gan Extendoffice 20211105
Ar Ail-ddechrau Gwall Nesaf
Ffoniwch SizeCircle ("Oval 1", Val (Ystod ("A1"). Gwerth)) 'A1 yw'r gell gwerth, hirgrwn 1 yw'r enw siâp
Ffoniwch SizeCircle ("Wyneb Gwenol 2", Val (Ystod ("A2"). Gwerth))
Ffoniwch SizeCircle ("Calon 3", Val (Ystod ("A3"). Gwerth))

Is-End
Is-daflen Waith Breifat_Newid(Targed ByVal Fel Ystod)
Dim xCyfeiriad Fel Llinyn
Ar Ail-ddechrau Gwall Nesaf
Os yw Target.CountLarge = 1 Yna
xCyfeiriad = Targed.Cyfeiriad(0, 0)
Os xAddress = "A1" Yna
Ffoniwch SizeCircle ("Oval 1", Val (Target.Value))
ElseIf xAddress = "A2" Yna
Ffoniwch SizeCircle ("Smiley Face 2", Val (Target.Value))
ElseIf xAddress = "A3" Yna
Ffoniwch SizeCircle ("Calon 3", Val (Target.Value))

Gorffennwch Os
Gorffennwch Os
Is-End

Cylch Is Maint (Enw Fel Llinyn, Diamedr)
Dim xCenterX Fel Sengl
Dim xCanolfan Fel Sengl
Dim x Cylch fel Siâp
Dim xDiamedr Fel Sengl
Ar Gwall Ewch i ExitSub
xDiameter = Diamedr
Os yw xDiameter > 10 Yna xDiameter = 10
Os yw xDiameter < 1 Yna xDiameter = 1
Gosod xCircle = ActiveSheet.Shapes(Name)
Gyda xCylch
xCenterX = .Chwith + (.Width/2)
xCenterY = .Top + (. Uchder / 2)
.Width = Cais.CentimetersToPoints(xDiameter)
.Uchder = Cais.CentimetersToPoints(xDiameter)
.Chwith = xCenterX - (.Width / 2)
.Top = xCenterY - (. Uchder / 2)
Diwedd Gyda
ExitSub:
Is-End

Nid oes unrhyw sylwadau wedi'u postio yma eto
Gadewch eich sylwadau
Postio fel Gwestai
×
Graddiwch y swydd hon:
0   Cymeriadau
Lleoliadau a Awgrymir