Formule in cell en mogelijkheid om waarde in te vullen

[fabsic01]

Hi,

Ik probeer het onmogelijke lijkt het maar misschien kunnen jullie mij helpen.
Om deelbetalingen te berekenen van een hoofdbedrag kun je percentages invullen om de deelbetaling uit te rekenen. Echter soms zijn de deelbetalingen beschikbaar en wil je terugrekenen naar percentage.

Ik probeer deze keuze 'open te zetten' dmv een 2 keuze drowdown (EUR en %) waardoor je in de juiste kolom je waarden kan zetten (EUR of %). Dit houdt in dat de formule niet in de cel zelf kan staan want daar moet je ook een waarde of percentage invoeren.

Ik heb de excel ter illustratie toegevoegd waarin bij 1 het bedrag wordt berekend wanneer je hetr percentage invoert en bij 2 wordt het percentage berekend wanneer je het bedrag invoert. Alleen wil ik dat op dezelfde regel en dat lukt dus niet. Mijn VBA skill is niet goed genoeg en ik weet bijna zeker dat dit wel nodig is hiervoor.

Kan iemand mij een zetje in de goed richting geven?

Alvast bedankt,
Stef

 

[JEC.]

Begin in D6 of in E6 te typen

Private Sub Worksheet_Change(ByVal Target As Range)
  With Target
    If .Count > 1 Then Exit Sub
    If Not Intersect(.Offset, Range("D6:E14")) Is Nothing Then
       Application.EnableEvents = False
      .Offset(, IIf(.Column = 5, -1, 1)) = Choose((.Column = 5) + 2, .Value / [E3], .Value * [E3])
       Application.EnableEvents = True
    End If
  End With
End Sub

 

[sylvester-ponte]

deze doet het ook als je meerdere cellen tegelijk wist.

Private Sub Worksheet_Change(ByVal Target As Range)
    Set ra = Range("D6:E14")
    Set temp = Intersect(Target, ra)
    If temp Is Nothing Then Exit Sub
    Application.EnableEvents = False
      For Each t In temp
        If t = "" Then
          Intersect(t.EntireRow, ra).ClearContents
        Else
          If t.Column = ra.Column Then
            t.Offset(, 1) = [E3] * t
          Else
            t.Offset(, -1) = t / [E3]
          End If
        End If
      Next
    Application.EnableEvents = True
End Sub

 

[JEC.]

Zonder de loop kan ook nog

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim r
  Set r = Range("D6:E14")
  With Target
    If Not Intersect(.Offset, r) Is Nothing Then
      Application.EnableEvents = False
      If .Cells(1) = "" Then
        Intersect(r, .EntireRow).ClearContents
      Else
        .Offset(, IIf(.Column = 5, -1, 1)) = Choose((.Column = 5) + 2, .Value / [E3], .Value * [E3])
      End If
      Application.EnableEvents = True
    End If
  End With
End Sub

 

[sylvester-ponte]

JEC, wouw , mooi , :thumb:

 

[fabsic01]

Helemaal geweldig dit! Beide zijn nog beter dan ikzelf had gewild!

thanks so much!

Groet,

steffen