Rund af/op til nærmeste hundrede, tusinde osv. med VBA makroer

Man kan få brug for at runde en værdi af eller op til nærmeste heltalsværdi (fx nærmeste tusinde), og her tænker jeg på, at 75 rundes op til 80, 499 til 500, 1027 til 2000 osv.

Helt konkret havde jeg brug for det til automatisk skalering af Y-aksen i et animeret diagram, hvor et søjlediagram blev animeret af en løkke.

Det duede ikke at sætte Y-aksen til automatisk skalering, for så ville den ændre sig, i takt med at søjlerne voksede, og animationen ville se tosset ud.

Jeg løste det ved at beregne slutværdien, før løkken (og animationen) blev startet, og så skalere Y-aksen op til nærmeste hele værdi, som jeg fandt med funktionen, som følger lidt længere nede.

Hvis man vidste, at der altid skulle rundes op til nærmeste tusinde, var det enkelt, for så kunne man bare skrive flg. kode, hvor jeg antager, at inputværdien er 1777:

Oprundet værdi = Fix(1777 / 1000) * 1000 + 1000

Men så enkelt er det ikke, hvis inputværdien kan være alt muligt andet - så må man have noget mere robust, som giver en fornuftig skalering, hvis inputværdien fx er 2, 77 eller 18.357,54.

Vil du afprøve koden, kan du markere den med musen, kopiere med CTRL+C og indsætte den i et VBA-modul. Da det er en funktion, returnerer den en værdi og skal kaldes af en anden funktion eller procedure. Nederst er en test-procedure, som viser et kald.

Function NearestRoundValue(ByVal dInputVal As Double)

Dim lRoundVal As Long   'Afrundet inputværdi
Dim lFactor As Long     'Faktor
Dim lValLenght As Long  'Antal cifre i den afrundede værdi
Dim lLoop As Long       'Tæller
Dim sNb As String       'Strengvariabel

On Error GoTo ErrorHandle

'Først afrunder vi inputværdien for at slippe af
'med evt. decimaler. For at få det rette antal
'cifre, hvis det er et negativt tal, bruger vi
'Abs-funktionen, som returnerer det absolutte tal.
lRoundVal = Round(Abs(dInputVal))

'Konverter det afrundede tal til tekst (String),
'fjern evt. blanke med Trim-funktionen, og tæl
'antal cifre med Len-funktionen.
'Træk 1 fra for at få det antal nuller, som
'vi vil tilføje senere, når vi skal lave vores
'faktor til af- eller oprunding.
lValLenght = Len(Trim(Str$(lRoundVal))) - 1

'Nu laver vi vores faktor som en tekststreng ved at
'tilføje nul X gange, hvor X = lValLength. Alternativet
'kunne være en Select Case konstruktion, men den
'ville blive temmelig lang!
sNb = "1"
For lLoop = 1 To lValLenght
   sNb = sNb & "0"
Next

'Konverter faktoren fra tekst til tal.
lFactor = Val(sNb)

'Nu finder vi det nærmeste hele tal opad. Er tallet
'tocifret, vil det være deleligt med 10. Er det trecifret,
'vil det være deleligt med 100 osv. Hvis du vil finde
'det nærmeste tal og ikke nødvendigvis opad,
'udelader du bare det afsluttende "+ lFactor)".
'I stedet for Round-funktionen bruges "Fix," som fjerner
'evt. decimaler uden op- eller nedrunding.
'Brugte man funktionen Round, ville det flg. returnere
'90, hvis lRoundVal var 75, og 80 hvis lRound var 74.
'Med Fix returneres 80 i begge tilfælde.
lRoundVal = Fix(lRoundVal / lFactor) * lFactor + lFactor

'Hvis inputværdien var negativ, skal lRound også
'være negativ.
If dInputVal < 0 Then
   lRoundVal = lRoundVal * -1
End If

NearestRoundValue = lRoundVal

Exit Function
ErrorHandle:
'En fejl vil typisk være overflow,
'hvis tallet er for stort.
MsgBox Err.Description
End Function

Herunder følger et eksempel på en procedure, som kalder funktionen ovenfor, og den returnerede værdi popper op i en boks. I eksemplet "fodres" funktionen med værdien 999,07, men ved reel brug vil værdien typisk være beregnet eller indlæst fra regnearket.

Afrunding i Excel med VBA makroer