vba functie aanroep in sub

[Symphysodon]

Beste forummers,
Het lukt maar niet om vanuit een code,het resultaat van een vba afrondfunctie terug te geven aan de worksheet.
Ik heb van alles geprobeerd maar de getallen in de sheet blijven onveranderd. Vanuit de sheet zelf werkt de functie wel goed.

Function Afronden_even(Getal) As Variant
Select Case Getal
    Case 0 To 0.9999999
        afgerond = Application.Fixed(Round(Getal, 2), 2)
    Case Is > 1
        afgerond = Application.Fixed(Round(Getal, 1), 1, -1)
    Case Else
        afgerond = afgerond
    End Select


Afronden_even = afgerond


End Function

Sub xrf_afronden_data_validatie()

  Application.ScreenUpdating = False
    'Set xRg = ActiveSheet.UsedRange
    Set xRg = Application.InputBox("Select a range:", "tools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    'On Error Resume Next
    For Each cell In xRg
       cell.Activate
       Afronden_even (Getal)
       
    Next
Application.ScreenUpdating = True

End Sub

In de bijlage een voorbeeldbestand.

Mvg
Marco

 

[VenA]

Je moet de waarde wel teruggeven aan de cel.

For Each cell In xRg
      cell.Value = Afronden_even(cell.Value)
    Next

 

[Symphysodon]

Als ik dat doe dan blijft getal in een loop in de functie ipv in de sub en de getallen in de sheet blijven nog onveranderd.

 

[edmoor]

Zet naast Application.ScreenUpdating ook Application.EnableEvents op False.

 

[Symphysodon]

Werkt nog niet. Code aangepast en door bij de eerste cell.value "value" weg te halen loopt de code wel in de sub en niet meer in de functie. Als ik cell.activate niet gebruik dan blijft ie loopen op 0, met cell.activate zie je in de functie well de goeie getallen tussen quotes staan alleen in de sheet gebeurt er niets..

Sub xrf_afronden_data_validatie()
  
    Set xRg = Application.InputBox("Select a range:", "tools for Excel", xTxt, , , , , 8)
    
    If xRg Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    For Each cell In xRg
       'cell.Activate
       cell = Afronden_even(cell.Value)
    Next
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

 

[jkpieterse]

Dit werkt bij mij prima:

Sub xrf_afronden_data_validatie()

  Application.ScreenUpdating = False
    'Set xRg = ActiveSheet.UsedRange
    Set xRg = Application.InputBox("Select a range:", "tools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    'On Error Resume Next
    For Each Cell In xRg
       Cell.Value = Afronden_even(Cell.Value)
    Next
    Application.ScreenUpdating = True

End Sub

 

[edmoor]

Bij mij ook.
Als zou ik nooit de naam van een bestaand object gebruiken om een nieuwe te maken:

Sub xrf_afronden_data_validatie()
  Set xRg = Application.InputBox("Select a range:", "tools for Excel", xTxt, , , , , 8)
  If Not xRg Is Nothing Then
      Application.ScreenUpdating = False
      For Each cl In xRg
         cl.Value = Afronden_even(cl.Value)
      Next
      Application.ScreenUpdating = True
  End If
End Sub

 

[Symphysodon]

Ik dacht ook dat ik het beetje begon te begrijpen maar bij mij werkt het niet. Zou je dat kunnen laten zien in het bestand van #1?
Alvast bedankt.

 

[edmoor]

Probeer het eens:
Bekijk bijlage Afrond_functie.xlsm

 

[jkpieterse]

Bij deze...

 

[Symphysodon]

Die van mij doet het niet die van jullie doen het wel, zoek de verschillen. Daar is nog wel een probleem dat het resultaat van de functie in de sheet klopt en die van vba niet. Bijvoorbeeld 3 moet worden 3.0 en wordt door de vba code gepresenteerd als 3, terwijl als ik de functie gebruik in de sheet wel 3.0 gegeven wordt.

 

[edmoor]

De getalnotatie is iets anders dan de werkelijke waarde.
In VBA bestaat 3.0 niet, dat is de cel notatie van een getal.

 

[jkpieterse]

Wat bedoel je hij doet het niet, wat gebeurt er precies als je door de sub heen stapt?

 

[Symphysodon]

De code doet het wel, het getallenvoorbeeld in #1 was wat beperkt. Het is zoals VenA in eerste instantie al zei.
Het gaat om de getalnotatie die blijkbaar niet goed is. Wat ik dan niet begrijp is waarom het in de sheet wel goed gaat. In kolom G waar de functie in de sheet vermeld staat, zijn de getallen zoals ik ze hebben wil. In kolom F wordt de functie aangeroepen door vba en daar gaat het niet goed (3 blijft 3 ipv 3.0). Misschien moet ik wat doen met Numberformat in de functie??

 

[jkpieterse]

De waarde in een cel en de weergave ervan zijn twee afzonderlijk in te stellen dingen. Jouw functie berekent de waarde, de weergave bepaal je door de cellen de juiste getalsopmaak te geven. In principe kan een functie dat niet als deze vanuit de cel wordt aangeroepen maar wel als hij wordt aangeroepen zoals in your Sub. Je moet alleen wat met numberformat in de functie doen als die niet vanuit de cel wordt aangesproken en als dat numberformat ook "dynamisch" moet zijn. Anders kan je net zo goed het numberformat handmatig goed instellen en klaar.

 

[Symphysodon]

De boolean 1 en -1 aan het eind van de fixed formule geeft toch de getalsopmaak weer als deze vanuit een cel wordt aangeroepen.
=Afronden_even(F13) geeft als resultaat 3.0 als er in de cel F13 3 staat en vanuit de sub blijft het 3.

 

[jkpieterse]

AHA, nu snap ik het. Het resultaat van de fixed functie is TEKST. Wat er dus in de cel komt te staan hangt af van hoe precies de waarde in de cel komt. In geval van de UDF wordt het een tekstwaarde in de cel en maakt de getalsopmaak geen verschil. In geval je de waarden via de sub in de cellen laat plaatsen hangt het af van de exacte manier waarop je dat doet.

 

[E v R]

nav post #7 en #15

For Each cl In xRg
       cl.NumberFormat = "@"
       cl.Value = Afronden_even(cl.Value)
Next

 

[Symphysodon]

Dit werkt met alle tips. De getallen worden netjes afgerond en gepresenteerd als tekst.

In een andere module wil ik het zelfde maar met getallen.
Het probleem dan is dat de functie round werkt volgens de bankafronding methode en dat is goed idg, alleen de presentatie lukt alleen met numberformat en die rond de getallen af op de 'normale' manier en dat is niet goed idg.
Met onderstaande code lukt het wel. Voorbeeld: 2.265 wordt afgerond en gepresenteerd als het getal 2.26. Met numberformat zou dat 2.27 zijn. Het probleem met mijn code is dat ik dan onderliggende formules kwijt ben. Bij numberformat zie je nog steeds de formule.


Hoe kan ik dit oplossen?

With Selection
    s = Selection
    r = Round(s, 2)
    p = Mid(r, 1, Len(r))
End With

 

[jkpieterse]

Bij mijn weten werkt de ROund werkbladfunctie niet met bankers rounding dus kan je APplication.Round(..) gebruiken. EVen testen uiteraard