Dynamisk oppdaterte celler i Excel?

[CrazyDog]

Hei eksperter, lurer på om noen av dere kan hjelpe meg med følgende problem (hvis det i det hele tatt er mulig):

 

Jeg har en prosentandel av forskjellige proteiner i celler bortover og har en celle til slutt viser summen av disse (som alltid skal være 100%). Dersom jeg da endrer en av disse verdiene, er det mulig at de andre cellene endrer seg tilsvarende slikt at summen fortsatt blir 100%?

 

Eks

 

30 30 30 10 100 (første fire celler inneholder prosentandelen, mens den siste er summen som alltid skal være 100)

 

Jeg endrer første celle fra 30 til 60, og de andre cellene vil da få reduserte sine verdier tilsvarende:

 

60 20 20 0 100

 

Er det mulig?

[deaktivert443556]

Nja... Du forsøke dette:

 

Høyreklikk i arkfanen og velg Vis Kode.

Lim inn følgende

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Differanse
Dim Sum
If Target.Column < 5 Then
   Sum = Application.WorksheetFunction.Sum(Range(Cells(Target.Row, 1), Cells(Target.Row, 4)))
   Differanse = (100 - Sum) / 3
   For Each x In Range(Cells(Target.Row, 1), Cells(Target.Row, 4))
       If Not x.Address = Target.Address Then
           Application.EnableEvents = False
           x.Value = x.Value + Differanse
       End If
   Next
   Application.EnableEvents = True
End If
End Sub

Hvis du starter med 30 30 30 10 og endrer den første til 60, da blir det 60 20 20 0, men om du endrer til 90 så blir det 90 10 10 -10 i stedet for 90 5 5 0. Dette kan man selvfølgelig få fikset, men jeg rekker ikke å se på det nå.

 

Et annet problem er at du får ikke tastet inn verdiene slik som de skal være. Så hvis du har en tom rad og du setter inn 40 i den første kolonnen, da blir det 20 20 20 i de neste tre. Her er det mulig å endre makroen slik at det ikke skal skje noe før det står en verdi i alle fire cellene i denne raden.

For å gjøre manuelle endringer nå, da må du deaktivere kjøringen av slike automatiske makroer. Det kan du gjøre ved å lage en makro med denne linjen:

Application.EnableEvents = Not Application.EnableEvents

Da kjører du denne for å slå av events og for å slå på igjen etterpå.

[CrazyDog]

Tusen takk for svar! Det virket, men det viser seg at dette ikke blir gjennomførbart fordi det ikke er mulig å skrive inn egne verdier, sidene de andre cellene endrer seg hele tiden... Blir nødt til å tenke helt annerledes, men tusen takk for genialt forslag!

[deaktivert443556]

Du kan teste denne. Nå skal ikke verdier kunne bli mindre enn null (uten at jeg har testet dette grundig). Du kan også slette verdier nå og det foretas ikke noe beregning dersom én eller flere av de andre cellene i raden er tomme.

 

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Differanse
Dim Sum
If Target.Column < 5 Then
   Sum = Application.WorksheetFunction.Sum(Range(Cells(Target.Row, 1), Cells(Target.Row, 4)))
   Differanse = (100 - Sum) / 3
   For Each x In Range(Cells(Target.Row, 1), Cells(Target.Row, 4))
       If x = "" Then Exit Sub
       If x.Value + Differanse < 0 Then
           Application.EnableEvents = False
           Differanse = Differanse - x.Value / 3
           x.Value = -Differanse
       End If
   Next
   For Each x In Range(Cells(Target.Row, 1), Cells(Target.Row, 4))
       If Not x.Address = Target.Address Then
           Application.EnableEvents = False
           x.Value = Round(x.Value + Differanse, 2)
       End If
   Next
   Application.EnableEvents = True
End If
End Sub

[CrazyDog]

Fantastisk! Tusen takk for hjelpen, dette var akkruat det jeg trengte!