• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

vba functie aanroep in sub

Status
Niet open voor verdere reacties.
Dat klopt maar het is juist de bedoeling dat er de bankers rounding gebruikt wordt. Het resultaat is tekst in de vorm van de getal notatie. De formule wordt overschreven en dat wil ik juist niet.
Met Numberformat wordt afgerond zonder bankers rounding, maar blijft het getal of de formule ongewijzigd zichtbaar in de formulebalk.
 
Ik snap niet wat je bedoelt, maar:
Code: 
Debug.Print Round(2.265, 2), Application.Round(2.265, 2)
geeft
2,26 2,27
 
ja. Het gaat me om round en niet om application.round.
Het probleem is dat als 2.265 het resultaat is van een formule deze wordt overschreven met het getal 2.26 en dat wil ik juist niet.
Met numberformat wordt de formule niet overschreven maar is het resultaat in de cel 2.27 ipv 2.26.
 
Laatst bewerkt:
Ik denk niet dat het kan. De vraag is simpel het antwoord is blijkbaar wat complexer. Eigenlijk wil ik de getalnotatie (numberformat) gebruiken maar dan met banking's rounding methode.

vb In een formule worden twee cellen bij elkaar opgeteld met als antwoord 2.665000. Als ik nu met de getalnotie het aantal decimalen verklein naar 2, dan wordt het resultaat in de cel 2.67 (het onafgeronde resultaat blijft 2.665).

Ik zoek dus een code die werkt als numberformat met banking's rounding en waarbij in het genoemde voorbeeld 2.66 in de cel komt te staan en in de formule balk de formule van de optelling idg
 
Dat gaat inderdaad niet in één cel. Je zal een cel moeten gebruiken alleen voor weergave die verwijst naar je berekening en de "reken" cel in je verdere calculaties moeten gebruiken.
 
Wat doet:
Code: 
afgerond = Application.Fixed([COLOR=#ff0000]Application.RoundUp[/COLOR](Getal, 2), 2)
 
nee, getal wordt naar boven afgerond ipv naar dichtstbijzijnde even getal. Met jou code wordt 2.665, 2.67 ipv 2.66
 
Plaats eens een bestand met de juiste resultaten in een ander kolom.
 
Laat maar.
 
Ik heb nu een code wat lijkt te werken alleen zodra ik het in een case stop (onderste code module 3) dan gaat het niet goed. Onderstaande code (module4) werkt voor getallen tussen 1 en 10. In de bijlage heb ik het bestand van #1 wat uitgebreid. De af te ronden getallen staan in kolom D. De copy/paste knop kopieert de getallen naar kolom F waar na selectie ook het resultaat komt te staan.
1 wordt 1.00
1.655 wordt 1.66
1.665 wordt 1.66


De code is nog niet helemaal gevalideerd omdat ik nog vast loop op de banking's rounding.

Code: 
Sub karakters()
'voor getallen tussen 1 en 10

s = Selection

l = Len(s)
lk = Right(s, l - (l - 1))
vl = Right(s, l - (l - 2))
vlk = Left(vl, Len(vl) - (Len(vl) - 1))

'presentatie gehele getallen
If s - Int(s) = 0 Then
    Selection.NumberFormat = "0.00"
ElseIf l = 5 Then
    If lk = 5 Then
        If vlk Mod 2 = 0 Then
            
            Selection.NumberFormat = "@"
            Selection = Round(s, 2)
            
        Else:
            Selection.NumberFormat = "0.00"
        End If
    End If
Else:
    Selection.NumberFormat = "0.00"

End If

End Sub

Code: 
Sub afronden_data()

'Set xRg = ActiveSheet.UsedRange
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.NumberFormat = "general" 'kapt nullen weg aan het eind
'        cl.NumberFormat = "@"
        l = Len(cl)
        lk = Right(cl, l - (l - 1))
        vl = Right(cl, l - (l - 2))
        vlk = Left(vl, Len(vl) - (Len(vl) - 1))
        
        Select Case cl
          Case -100000 To -10000
              cl = cl / 1000
              Y = Int(Log(Round(Abs(cl), 14)) / Log(10#) + 1)
              cl = Round(Round(cl, 14), Abs(Y)) * 1000
          Case -10000 To -1000
              cl.NumberFormat = "0"
          Case -1000 To -100
              cl.NumberFormat = "0"
          Case -100 To -10
            If cl - Int(cl) = 0 Then
                cl.NumberFormat = "0"
            ElseIf l = 4 Then
                If lk = 5 Then
                    If vlk Mod 2 = 0 Then
                        cl.NumberFormat = "@"
                        cl = Round(cl, 0)
                    Else:
                        cl.NumberFormat = "0"
                    End If
                End If
            Else:
                cl.NumberFormat = "0"
            End If
          Case -9.99999 To -1
            If cl - Int(cl) = 0 Then
                cl.NumberFormat = "0.0"
            ElseIf l = 5 Then
                If lk = 5 Then
                    If vlk Mod 2 = 0 Then
                        cl.NumberFormat = "@"
                        cl = Round(cl, 1)
                    Else:
                        cl.NumberFormat = "0.0"
                    End If
                End If
            Else:
                cl.NumberFormat = "0.0"
            End If
          Case -0.9999999 To -0.1
            If cl - Int(cl) = 0 Then
                cl.NumberFormat = "0.00"
            ElseIf l = 6 Then
                If lk = 5 Then
                    If vlk Mod 2 = 0 Then
                        cl.NumberFormat = "@"
                        cl = Round(cl, 2)
                    Else:
                        cl.NumberFormat = "0.00"
                    End If
                End If
            Else:
                cl.NumberFormat = "0.00"
            End If
          Case -0.0999999 To -0.01
            If cl - Int(cl) = 0 Then
                cl.NumberFormat = "0.000"
            ElseIf l = 7 Then
                If lk = 5 Then
                    If vlk Mod 2 = 0 Then
                        cl.NumberFormat = "@"
                        cl = Round(cl, 3)
                    Else:
                        cl.NumberFormat = "0.000"
                    End If
                End If
            Else:
                cl.NumberFormat = "0.000"
            End If
          Case -0.00999999 To -0.001
            If cl - Int(cl) = 0 Then
                cl.NumberFormat = "0.0000"
            ElseIf l = 7 Then
                If lk = 5 Then
                    If vlk Mod 2 = 0 Then
                        cl.NumberFormat = "@"
                        cl = Round(cl, 4)
                    Else:
                        cl.NumberFormat = "0.0000"
                    End If
                End If
            Else:
                cl.NumberFormat = "0.0000"
            End If
          Case -0.00099999 To -0.0001
            If cl - Int(cl) = 0 Then
                cl.NumberFormat = "0.00000"
            ElseIf l = 8 Then
                If lk = 5 Then
                    If vlk Mod 2 = 0 Then
                        cl.NumberFormat = "@"
                        cl = Round(cl, 5)
                    Else:
                        cl.NumberFormat = "0.00000"
                    End If
                End If
            Else:
                cl.NumberFormat = "0.00000"
            End If
          Case -0.000099999 To 0.00001
            If cl - Int(cl) = 0 Then
                cl.NumberFormat = "0"
            ElseIf l = 4 Then
                If lk = 5 Then
                    If vlk Mod 2 = 0 Then
                        cl.NumberFormat = "@"
                        cl = Round(cl, 0)
                    Else:
                        cl.NumberFormat = "0"
                    End If
                End If
            Else:
                cl.NumberFormat = "0"
            End If
          'Positieve cllen
          Case 0.00001 To 0.000099999
            If cl - Int(cl) = 0 Then
                cl.NumberFormat = "0"
            ElseIf l = 4 Then
                If lk = 5 Then
                    If vlk Mod 2 = 0 Then
                        cl.NumberFormat = "@"
                        cl = Round(cl, 0)
                    Else:
                        cl.NumberFormat = "0"
                    End If
                End If
            Else:
                cl.NumberFormat = "0"
            End If
          Case 0.0001 To 0.00099999
            If cl - Int(cl) = 0 Then
                cl.NumberFormat = "0.00000"
            ElseIf l = 7 Then
                If lk = 5 Then
                    If vlk Mod 2 = 0 Then
                        cl.NumberFormat = "@"
                        cl = Round(cl, 5)
                    Else:
                        cl.NumberFormat = "0.00000"
                    End If
                End If
            Else:
                cl.NumberFormat = "0.00000"
            End If
          Case 0.001 To 0.00999999
            If cl - Int(cl) = 0 Then
                cl.NumberFormat = "0.0000"
            ElseIf l = 6 Then
                If lk = 5 Then
                    If vlk Mod 2 = 0 Then
                        cl.NumberFormat = "@"
                        cl = Round(cl, 4)
                    Else:
                        cl.NumberFormat = "0.0000"
                    End If
                End If
            Else:
                cl.NumberFormat = "0.0000"
            End If
          Case 0.01 To 0.0999999
            If cl - Int(cl) = 0 Then
                cl.NumberFormat = "0.0000"
            ElseIf l = 7 Then
                If lk = 5 Then
                    If vlk Mod 2 = 0 Then
                        cl.NumberFormat = "@"
                        cl = Round(cl, 4)
                    Else:
                        cl.NumberFormat = "0.0000"
                    End If
                End If
            Else:
                cl.NumberFormat = "0.0000"
            End If
          Case 0.1 To 0.9999999
            If cl - Int(cl) = 0 Then
                cl.NumberFormat = "0.000"
            ElseIf l = 6 Then
                If lk = 5 Then
                    If vlk Mod 2 = 0 Then
                        cl.NumberFormat = "@"
                        cl = Round(cl, 3)
                    Else:
                        cl.NumberFormat = "0.000"
                    End If
                End If
            Else:
                cl.NumberFormat = "0.000"
            End If
          Case 1 To 9.99999
            If cl - Int(cl) = 0 Then
                cl.NumberFormat = "0.00"
            ElseIf l = 5 Then
                If lk = 5 Then
                    If vlk Mod 2 = 0 Then
                        cl.NumberFormat = "@"
                        cl = Round(cl, 2)
                    Else:
                        cl.NumberFormat = "0.00"
                    End If
                End If
            Else:
                cl.NumberFormat = "0.00"
            End If
          Case 10 To 100
            If cl - Int(cl) = 0 Then
                cl.NumberFormat = "0.0"
            ElseIf l = 3 Then
                If lk = 5 Then
                    If vlk Mod 2 = 0 Then
                        cl.NumberFormat = "@"
                        cl = Round(cl, 1)
                    Else:
                        cl.NumberFormat = "0.0"
                    End If
                End If
            Else:
                cl.NumberFormat = "0.0"
            End If
          Case 100 To 1000
              cl.NumberFormat = "0"
          Case 1000 To 10000
              cl.NumberFormat = "0"
          Case 10000 To 1000000000
              cl.NumberFormat = "0"
        End Select
        
    Next
    
    Application.ScreenUpdating = True
End If
End Sub
 

Bijlagen

De link beschrijft nagenoeg mijn probleem alleen ik kom op een simpeler manier tot het gewenste resultaat. Het probleem is dat het in mijn select case code niet werkt, alleen in de If then functie (module 4 van het voorbeeldbestand) werkt het wel.

Het is lastig om het met tekst allemaal uit te leggen, ik heb het bestand nogmaals aangepast en de gewenste presentatie in kolom G gezet. Hopelijk is het dan wat duidelijker en volgens mij is het voor jullie makkelijk op te lossen. Ik ben er helaas al uren mee bezig.

Dank voor jullie geduld.
 

Bijlagen

Programma aangepast. Toch maar een formule gebruikt voor het afronden. Omdat de afrondregels per decade verschillen heb ik (en het forum) een log functie gebruikt. De notatie van gehele getallen heb ik apart bewerkt en voor de hele grote getallen heb ik de Mround functie gebruikt.
Code: 
Function RondAf2(Getal) As Double
    If Getal < 0 Then
        Getal = -Getal
        Y = Int(Log(Round(Getal, 14)) / Log(10#) - 1)
        r = IIf(Y < 1, Round(Round(Getal, 14), Abs(Y)), WorksheetFunction.MRound(Getal, 10 ^ Y))
        RondAf2 = -r
    ElseIf Getal > 0.0099999 And Getal < 100 Then
        Y = Int(Log(Round(Getal, 14)) / Log(10#) - 1)
        RondAf2 = IIf(Y < 1, Round(Round(Getal, 14), Abs(Y) + 1), WorksheetFunction.MRound(Getal, 10 ^ Y))
    Else
        Y = Int(Log(Round(Getal, 14)) / Log(10#) - 1)
        RondAf2 = IIf(Y < 1, Round(Round(Getal, 14), Abs(Y)), WorksheetFunction.MRound(Getal, 10 ^ Y))
    End If
End Function

Code: 
Sub afrondfunctie()
    'Programma overschrijft formules en rond getallen af volgens bankers rounding methode
    Set xRg = Application.InputBox("Select a range:", "tools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    
    For Each cl In xRg
        If cl.NumberFormat <> "@" And IsNumeric(cl.Value) And cl.Value <> "" And Not IsDate(cl) Then
         If cl <= 10 And Int(cl) = cl Then
            cl.NumberFormat = "0.00"
         ElseIf cl <= 100 And Int(cl) = cl Then
             cl.NumberFormat = "0.0"
         Else
             cl.NumberFormat = "@"
             cl.Value = RondAf2(cl.Value)
         End If
        End If
    Next
    Application.ScreenUpdating = True


End Sub

In de bijlage het voorbeeldbestand nog wat verbeterd. De code staat in de module: bankers_rounding
 

Bijlagen

Jammer dat, ondanks gebruikt wordt gemaakt van 'Dirty' dat toch alle cellen i.p.v. cl uit de 'inputbox' herberekend worden in de UDF.
cl.calculate eveneens.

Code: 
Function Afronden_even(getal As Range)
  Select Case getal.Value
    Case 0 To 0.9999999
        Afronden_even = Application.Fixed(Round(getal, 2), 2)
    Case Is > 1
        Afronden_even = Application.Fixed(Round(getal, 1), 1, -1)
    Case Else
        Afronden_even = Afronden_even
   End Select
 Debug.Print Afronden_even, getal, getal.Address, Time
End Function


Sub xrf_afronden_data_validatie()
Dim xRg As Range, cl As Range, n As Range
On Error Resume Next
 Set xRg = Application.InputBox("Select a range:", "tools for Excel", "0", , , , , 8)
   If xRg Is Nothing Then Exit Sub
     For Each cl In xRg
      Afronden_even cl
        cl.Dirty
     Next cl
End Sub
 
Laatst bewerkt:
Bedankt allemaal voor de input, ik heb nu twee werkende codes.

Het aanpassen van de functionaliteit van Numberformat blijft natuurlijk een uitdaging.

Mvg
Marco
 
Vreemd dat in de 'Debug.Print' het resultaat wel juist is maar de functie niet wordt herberekend in de UDF zonder cl.dirty.

Heb je het bekeken in 'Venster Direct'?
Code: 
Debug.Print Afronden_even, getal, getal.Address, Time
 
Ja klopt, met de aanpassing:
Code: 
     For Each cl In xRg
      cl.NumberFormat = "@"
      cl.Value = Afronden_even(cl)
     Next cl
werkt het wel.
 
Maar dan is de formule weg.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan