gtal 2 cijfers achter de komma afhakken

Status
Niet open voor verdere reacties.
R

Robertflink

Gebruiker
Lid geworden
4 jul 2007
Berichten
533
Ik het navolgende stukje code in mijn prg staan. Ik wil een getal afhakken met 2 cijfers achter de komma bijvb 29/31 = 0,935 moet worden 0,93

Hieronder de code

Public Function Aantal_Punten(Caramboles As Integer, Te_Halen As Integer, Bonus As Integer, winstpnt As Integer, Car_tegensp As Integer, Te_halen_tegensp As Integer) As Double
Dim Punten As Double
Dim punten_tegenst As Double
Dim Heel_punten As Integer
Dim Breuk As Integer
If Te_Halen <> 0 Then
Punten = (Caramboles / Te_Halen)
End If
' Bepaal punten
If Te_halen_tegensp <> 0 Then
punten_tegenst = (Car_tegensp / Te_halen_tegensp)
End If
If Punten >= 1 Then
Punten = Punten * winstpnt
If punten_tegenst >= 1 Then
Punten = Punten + (Bonus / 2)
Else
Punten = Punten + Bonus
End If
Else
Punten = Punten * winstpnt
End If


Zie het antwoord graag tegemoet

Rober Fli nk
 
En op welk moment in die berekening moet die afronding worden gemaakt?
Zou je overigens je code willen opmaken met de CODE knop (knop # )
 
afhakken

Sorry maar het gaat om de punten. Wat bedoel je met de codeknop?
 
Als je een bericht maakt heb je een aantal opmaak knoppen. Eén daarvan is de Code knop (die met het # teken). Daarmee word code netjes ingesprongen, en dus beter leesbaar. Dus zoals dit:
Code: 
Public Function Aantal_Punten(Caramboles As Integer, Te_Halen As Integer, Bonus As Integer, _
    Winstpnt As Integer, Car_tegensp As Integer, Te_halen_tegensp As Integer) As Double

Dim Punten As Double, Punten_tegenst As Double
Dim Heel_punten As Integer, Breuk As Integer

    If Te_Halen <> 0 Then Punten = (Caramboles / Te_Halen)
    If Te_halen_tegensp <> 0 Then Punten_tegenst = (Car_tegensp / Te_halen_tegensp)
    ' Bepaal punten
    If Punten >= 1 Then
        Punten = Punten * Winstpnt
        If Punten_tegenst >= 1 Then
            Punten = Punten + (Bonus / 2)
        Else
            Punten = Punten + Bonus
        End If
    Else
        Punten = Punten * Winstpnt
    End If
    Aantal_Punten = Round(Punten, 2)
End Function
 
The syntax for the Round function is:


Round ( expression, [ decimal_places ] )

expression is a numeric expression that is to be rounded.

decimal_places is optional. It is the number of decimal places to round the expression to. If this parameter is omitted, then the Round function will return an integer.


is dit wat je zoekt?
 
hierbij het gehele stuk

Code: 
Option Compare Database

Public Function TeBehalenCaramboles(rbbnr As Integer, Afd_spels As Long) As Integer
  Dim con As Object
  Dim rst As Object
  Dim Spelsoort As Integer
  Dim tabelnr As Integer
  Dim gemiddelde As Double
  Dim SqlStr As String
  
  Set con = Application.CurrentProject.Connection
  
  Set rst = CreateObject("ADODB.Recordset")
  SqlStr = "SELECT * from [afd-spels] WHERE [Afd_spelnr] = " & Afd_spels
  rst.Open SqlStr, con, 1
  
  If (rst.EOF) Then
    MsgBox "Afdeling - spelsoort niet gevonden"
    rst.Close
    Set rst = Nothing
    Set con = Nothing
    Exit Function
  End If
  
  tabelnr = rst![Tabelnummer]
  Spelsoort = rst![Spelsoortnr]
  
  rst.Close
  Set rst = Nothing
  
  Set rst = CreateObject("ADODB.Recordset")
  SqlStr = "SELECT * from [Gemiddelden] WHERE [speler] = " & rbbnr
  SqlStr = SqlStr & " AND [spelsoort] = " & Spelsoort
  rst.Open SqlStr, con, 1
  
  If (rst.EOF) Then
    gemiddelde = 0
  Else
    gemiddelde = rst![gemiddelde]
  End If
  
  rst.Close
  Set rst = Nothing
  Set rst = CreateObject("ADODB.Recordset")
  
  SqlStr = "SELECT * from [rekentabel] WHERE [TNR] = " & tabelnr
  SqlStr = SqlStr & " AND [MIN] <= " & gemiddelde
  rst.Open SqlStr, con, 1

  If (rst.EOF) Then
    MsgBox "Geen tabel record"
    rst.Close
    Set rst = Nothing
    Set con = Nothing
    Exit Function
  End If
  rst.MoveLast
  
  TeBehalenCaramboles = rst![tehalen]
  
  rst.Close
  Set rst = Nothing
  Set con = Nothing
End Function

Public Function BerekenGemiddelde(rbbnr As Integer, Spelsoort As Integer) As Double
  Dim con As Object
  Dim rst As Object
  Dim Caramboles As Double
  Dim beurten As Integer
  Dim gemiddelde As Double
  Dim Hulpstring As String
  
  Set con = Application.CurrentProject.Connection
  Set rst = CreateObject("ADODB.RecordSet")
 ' eerst voor de thuiswedstrijden
 
  Hulpstring = "SELECT SUM(thuiscaramb)As [Caramboles], SUM(gespeelde_beurten) As [Beurten]"
  Hulpstring = Hulpstring & " FROM [afd-spels] INNER JOIN (competitie INNER JOIN "
  Hulpstring = Hulpstring & "(wedstrijd INNER JOIN partij ON wedstrijd.Wedstrijdnr = partij.wedstrijdnr)"
  Hulpstring = Hulpstring & "ON competitie.Copetitienr = wedstrijd.competitienr) ON "
  Hulpstring = Hulpstring & "[afd-spels].Afd_spelnr = competitie.Afd_spel"
  Hulpstring = Hulpstring & " WHERE [partij]![Thuisspeler] = " & rbbnr & " AND "
  Hulpstring = Hulpstring & "[afd-spels]![spelsoortnr] = " & Spelsoort
  
  rst.Open Hulpstring, con, 1
  
  If IsNull(rst!Caramboles) Then
    Caramboles = 0
  Else
    Caramboles = rst!Caramboles
  End If
  
  If IsNull(rst!beurten) Then
    beurten = 0
  Else
    beurten = rst!beurten
  End If
  
  ' dan voor de uitwedstrijden
  rst.Close
  
  Hulpstring = "SELECT SUM(uitcaramb)As [Caramboles], SUM(gespeelde_beurten) As [Beurten]"
  Hulpstring = Hulpstring & " FROM [afd-spels] INNER JOIN (competitie INNER JOIN "
  Hulpstring = Hulpstring & "(wedstrijd INNER JOIN partij ON wedstrijd.Wedstrijdnr = partij.wedstrijdnr)"
  Hulpstring = Hulpstring & "ON competitie.Copetitienr = wedstrijd.competitienr) ON "
  Hulpstring = Hulpstring & "[afd-spels].Afd_spelnr = competitie.Afd_spel"
  Hulpstring = Hulpstring & " WHERE [partij]![Uitspeler] = " & rbbnr & " AND "
  Hulpstring = Hulpstring & "[afd-spels]![spelsoortnr] = " & Spelsoort
  
  rst.Open Hulpstring, con, 1
  
  If IsNull(rst!Caramboles) Then
    Caramboles = Caramboles + 0
  Else
    Caramboles = Caramboles + rst!Caramboles
  End If
  
  If IsNull(rst!beurten) Then
    beurten = beurten + 0
  Else
    beurten = beurten + rst!beurten
  End If
  
' eerst het ruwe gemiddelde
  Caramboles = Caramboles * 1000
  
  If beurten = 0 Then
     beurten = 1
  End If
  
  gemiddelde = Caramboles / beurten
' en dan afronden op drie cijfers achter de komma
  gemiddelde = Fix(gemiddelde + 0.5)
  
  BerekenGemiddelde = gemiddelde / 1000
  
  rst.Close
  Set rst = Nothing
  Set con = Nothing
End Function

Public Function Aantal_Punten(Caramboles As Integer, Te_Halen As Integer, Bonus As Integer, winstpnt As Integer, Car_tegensp As Integer, Te_halen_tegensp As Integer) As Double
  Dim Punten As Double
  Dim punten_tegenst As Double
  Dim Heel_punten As Integer
  Dim Breuk As Integer
  If Te_Halen <> 0 Then
    Punten = (Caramboles / Te_Halen)
  End If
  ' Bepaal punten
  If Te_halen_tegensp <> 0 Then
    punten_tegenst = (Car_tegensp / Te_halen_tegensp)
  End If
  If Punten >= 1 Then
    Punten = Punten * winstpnt
    If punten_tegenst >= 1 Then
        Punten = Punten + (Bonus / 2)
    Else
        Punten = Punten + Bonus
    End If
  Else
    Punten = Punten * winstpnt
  End If
  
  ' Rond af op 0,5 NAAR BENEDEN
  Heel_punten = Int(Punten)
  Breuk = (Punten - Heel_punten) * 100
  
' RD afronden op half weggehaald
'  If Breuk < 50 Then
'    Breuk = 0
'  Else
'    Breuk = 50
'  End If
  
  Punten = Heel_punten + (Breuk / 100)
 
   Aantal_Punten = Punten
  'Aantal_Punten = Round(Punten, 2)
  If Aantal_Punten > 10 Then Aantal_Punten = 10
  
 
End Function

Public Function Haal_Gemiddelde_Op(rbbnr As Integer, Spelsoort As Integer) As Double
  Dim con As Object
  Dim rst As Object
  Dim SqlStr As String
  
  Set con = Application.CurrentProject.Connection
  Set rst = CreateObject("ADODB.Recordset")
  SqlStr = "SELECT * from [gemiddelden] WHERE [speler] = " & rbbnr
  SqlStr = SqlStr & " AND [spelsoort] = " & Spelsoort
  rst.Open SqlStr, con, 1
  
  If (rst.EOF) Then
  Else
    Haal_Gemiddelde_Op = rst![gemiddelde]
  End If
  rst.Close
  Set rst = Nothing
  Set con = Nothing
End Function

Public Function Haal_Herberekenen_Op(rbbnr As Integer, Spelsoort As Integer) As Boolean
  Dim con As Object
  Dim rst As Object
  Dim SqlStr As String
  
  Set con = Application.CurrentProject.Connection
  Set rst = CreateObject("ADODB.Recordset")
  SqlStr = "SELECT * from [gemiddelden] WHERE [speler] = " & rbbnr
  SqlStr = SqlStr & " AND [spelsoort] = " & Spelsoort
  rst.Open SqlStr, con, 1
  
  If (rst.EOF) Then
  Else
    Haal_Herberekenen_Op = rst![Herberekenen]
  End If
  rst.Close
  Set rst = Nothing
  Set con = Nothing
End Function

Public Function Haal_Aant_Wedstr_Op(rbbnr As Integer, Spelsoort As Integer) As Integer
  Dim con As Object
  Dim rst As Object
  Dim SqlStr As String
  
  Set con = Application.CurrentProject.Connection
  Set rst = CreateObject("ADODB.Recordset")
  
  SqlStr = "SELECT [wedstrijd].[Wedstrijdnr] FROM [afd-spels] INNER JOIN "
  SqlStr = SqlStr & "(competitie INNER JOIN (wedstrijd INNER JOIN partij "
  SqlStr = SqlStr & "ON wedstrijd.Wedstrijdnr = partij.wedstrijdnr) ON "
  SqlStr = SqlStr & "competitie.Copetitienr = wedstrijd.competitienr) ON "
  SqlStr = SqlStr & "[afd-spels].Afd_spelnr = competitie.Afd_spel"
  SqlStr = SqlStr & " WHERE ([afd-spels].Spelsoortnr = " & Spelsoort
  SqlStr = SqlStr & " And (partij.thuisspeler = " & rbbnr & " Or partij.Uitspeler = " & rbbnr
  SqlStr = SqlStr & ")) GROUP BY wedstrijd.Wedstrijdnr; "
  
  rst.Open SqlStr, con, 1
  
  If (rst.EOF) Then
     Haal_Aant_Wedstr_Op = 0
  Else
    rst.MoveLast
    Haal_Aant_Wedstr_Op = rst.RecordCount
  End If
  rst.Close
  Set rst = Nothing
  Set con = Nothing
End Function

Public Function Haal_Aant_Partijen_Op(rbbnr As Integer, Spelsoort As Integer) As Integer
  Dim con As Object
  Dim rst As Object
  Dim SqlStr As String
  
  Set con = Application.CurrentProject.Connection
  Set rst = CreateObject("ADODB.Recordset")

  SqlStr = "SELECT Count([partij].[bordnr]) AS Aantal_partijen"
  SqlStr = SqlStr & " FROM [afd-spels] INNER JOIN (competitie INNER JOIN (wedstrijd INNER JOIN partij ON wedstrijd.Wedstrijdnr = partij.wedstrijdnr) ON competitie.Copetitienr = wedstrijd.competitienr) ON [afd-spels].Afd_spelnr = competitie.Afd_spel"
  SqlStr = SqlStr & " WHERE ((([afd-spels].Spelsoortnr)= " & Spelsoort
  SqlStr = SqlStr & ") AND ((partij.thuisspeler)= " & rbbnr & ")) OR ((([afd-spels].Spelsoortnr)="
  SqlStr = SqlStr & Spelsoort & ") AND ((partij.uitspeler) = " & rbbnr & "));"
  
  rst.Open SqlStr, con, 1
  
  If (rst.EOF) Then
     Haal_Aant_Partijen_Op = 0
  Else
     Haal_Aant_Partijen_Op = rst!Aantal_partijen
  End If
  rst.Close
  Set rst = Nothing
  Set con = Nothing
End Function

Public Function Haal_Vereniging_Op(rbbnr As Integer, Spelsoort As Integer) As Integer
  Dim con As Object
  Dim rst As Object
  Dim SqlStr As String
  
  Set con = Application.CurrentProject.Connection
  Set rst = CreateObject("ADODB.Recordset")

  SqlStr = "SELECT vereniging.Verenigingsnr As Vereniging FROM vereniging INNER JOIN ([afd-spels] INNER JOIN (competitie INNER JOIN "
  SqlStr = SqlStr & "(team INNER JOIN teamleden ON (team.teamnr = teamleden.Teamnr) AND (team.teamnr = teamleden.Teamnr)) "
  SqlStr = SqlStr & "ON competitie.Copetitienr = team.Competitienr) ON [afd-spels].Afd_spelnr = competitie.Afd_spel) "
  SqlStr = SqlStr & "ON (vereniging.Verenigingsnr = team.Vereniging) AND (vereniging.Verenigingsnr = team.Vereniging)"
  SqlStr = SqlStr & " WHERE (((teamleden.Lidnr)= " & rbbnr & ") AND (([afd-spels].Spelsoortnr)= " & Spelsoort & "));"
  
  rst.Open SqlStr, con, 1
  
  If (rst.EOF) Then
     Haal_Vereniging_Op = ""
  Else
     Haal_Vereniging_Op = rst!Vereniging
  End If
  rst.Close
  Set rst = Nothing
  Set con = Nothing
End Function
Public Function Haal_Ver_Oms_Op(Vereniging As Integer) As String
  Dim con As Object
  Dim rst As Object
  Dim SqlStr As String
  
  Set con = Application.CurrentProject.Connection
  Set rst = CreateObject("ADODB.Recordset")

  SqlStr = "SELECT Naam FROM [Vereniging] WHERE [Verenigingsnr] = " & Vereniging & ";"
  
  rst.Open SqlStr, con, 1
  
  If (rst.EOF) Then
     Haal_Ver_Oms_Op = ""
  Else
     Haal_Ver_Oms_Op = rst!Naam
  End If
  rst.Close
  Set rst = Nothing
  Set con = Nothing
End Function


Public Function Haal_Afd_spel_Op(rbbnr As Integer, Spelsoort As Integer) As Long
  Dim con As Object
  Dim rst As Object
  Dim SqlStr As String
  
  Set con = Application.CurrentProject.Connection
  Set rst = CreateObject("ADODB.Recordset")

  SqlStr = "SELECT competitie.Afd_spel As Afd_spel FROM [afd-spels] INNER JOIN ((competitie INNER JOIN team ON"
  SqlStr = SqlStr & " competitie.Copetitienr = team.Competitienr) INNER JOIN teamleden ON "
  SqlStr = SqlStr & "(team.teamnr = teamleden.Teamnr) AND (team.teamnr = teamleden.Teamnr)) "
  SqlStr = SqlStr & "ON [afd-spels].Afd_spelnr = competitie.Afd_spel WHERE (((teamleden.Lidnr)="
  SqlStr = SqlStr & rbbnr & ") AND (([afd-spels].Spelsoortnr)=" & Spelsoort & "));"
  
  rst.Open SqlStr, con, 1
  
  If (rst.EOF) Then
     Haal_Afd_spel_Op = ""
  Else
     Haal_Afd_spel_Op = rst!Afd_spel
  End If
  rst.Close
  Set rst = Nothing
  Set con = Nothing
End Function

Public Function Haal_Afd_spel_Oms_Op(Afd_spels As Long) As String
  Dim con As Object
  Dim rst As Object
  Dim SqlStr As String
  
  Set con = Application.CurrentProject.Connection
  Set rst = CreateObject("ADODB.Recordset")

  SqlStr = "SELECT Omschrijving FROM [afd-spels] WHERE [Afd_spelnr] = " & Afd_spels & ";"
  
  rst.Open SqlStr, con, 1
  
  If (rst.EOF) Then
     Haal_Afd_spel_Oms_Op = ""
  Else
     Haal_Afd_spel_Oms_Op = rst!Omschrijving
  End If
  rst.Close
  Set rst = Nothing
  Set con = Nothing
End Function

Public Function TeBehalenNieuwCaramboles(Nw_Gem As Integer, Afd_spels As Long) As Integer
  Dim con As Object
  Dim rst As Object
  Dim Spelsoort As Integer
  Dim tabelnr As Integer
  Dim gemiddelde As Double
  Dim SqlStr As String
  
  Set con = Application.CurrentProject.Connection
  
  Set rst = CreateObject("ADODB.Recordset")
  SqlStr = "SELECT * from [afd-spels] WHERE [Afd_spelnr] = " & Afd_spels
  rst.Open SqlStr, con, 1
  
  If (rst.EOF) Then
    MsgBox "Afdeling - spelsoort niet gevonden"
    rst.Close
    Set rst = Nothing
    Set con = Nothing
    Exit Function
  End If
  
  tabelnr = rst![Tabelnummer]
  Spelsoort = rst![Spelsoortnr]
  
  rst.Close
  Set rst = Nothing
  
  Set rst = CreateObject("ADODB.Recordset")
  
  SqlStr = "SELECT * from [rekentabel] WHERE [TNR] = " & tabelnr
  SqlStr = SqlStr & " AND [MIN] <= " & Nw_Gem
  rst.Open SqlStr, con, 1

  If (rst.EOF) Then
    MsgBox "Geen tabel record"
    rst.Close
    Set rst = Nothing
    Set con = Nothing
    Exit Function
  End If
  rst.MoveLast
  
  TeBehalenNieuwCaramboles = rst![tehalen]
  
  rst.Close
  Set rst = Nothing
  Set con = Nothing
End Function
 
afkappen van getal

In Excedl hebben we de functie geheel, die wil ik graag in deze code zetten. ik moet de punten met 2 cijfers achter de komma en afgekapt presenteren

de uitkomst van 29/32 = 0,906 wat gepresenteerd zou worden als 0,91 en ik wil dus zien als uitkomst 0,90
 
In mijn voorbeeldje staat de functie Round al waarmee je kunt afronden, en jwaque heeft hem daarna ook nog een keer gegeven. Hoe vaak wil je hem krijgen?
Access is geen Excel, en functies als Afronden.naar.Boven etc kent Access dan ook niet. Round is zo'n beetje de enige functie. Wil je een een berekening als 29/32 afronden naar 0,9, dan moet je dus afronden met één decimaal.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan