A
A.Buchanan
Because I was unable to trace any suitable existing code I have
developed a VBA / VB function to take a number in any numeric base
and convert it to a number in a different base.
As other people may find this function useful I give it below
(ACB) :-
Public Function fChangeBase(lOldNoString As String, lOldBase As
Integer, lNewBase As Integer) As String
'fCHANGEBASE
' ------------------------------------------------------------------------
' Numeric number base changing function
' by Alan C. Buchanan, Somerset, BA5 1PN, U.K.- September
2003
' ------------------------------------------------------------------------
' Feed a number in any base together with an integer number
indicating the base.
' Also feed a second integer giving the base into which the number
is to be converted.
' The function will return the given number in the new base.
' (The function will handle fractional number (i.e. with a
point).)
'
' Restrictions:-
' a) The order in which the 'digits' in the supplied number string
occur must conform to
' those shown in the lNewDigit string shown below.
' b) As supplied the function handles bases between 2 and 62
' c) The function works by converting the given number to base10
and then converting
' this base10 number to the target base. It follows that the
accuracy of the
' conversion depends on the accuracy of the (double-byte)
base10 arithmetic.
' Accuracy begins to get lost for numbers greater than
999999999999999 .
' d) Fractional arithmetic, the conversion of the fractional part
of any number, may also
' be inaccurate (depending on the two bases involved).
'
' (My understanding is that the IEEE 754 standard imposes a limit
on the accuracy but
' perhaps both these precision problems could be fixed by using a
high precision arithmetic add-in
' like, for example , xlPrecision
(http://precisioncalc.com/What is xlPrecision.html).
' I have not tried such an add-in as including one would mean that
the function would be
' limited to users would had it.)
'
' Usage :-
' You are free to use this function, for personal use and as a
basis for further
' experiment, under General Open Source conditions (GPL).
' If, however, you incorporate it into a commercial product,
please forward a
' suitable contribution for the Buchanan coffers!
Dim lNewDigits As String
Dim lPoint As Integer
Dim lIntegerPart As String
Dim lFractionalPart As String
Dim lBase10Ver As Double
lNewDigits = "123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
If lOldBase < 2 Or lOldBase > 62 Or lNewBase < 2 Or lNewBase > 62
Then
MsgBox "Bases must be between 2 and 62", vbOKOnly +
vbCritical
fChangeBase = 0
Exit Function
End If
lBase10Ver = fToBase10(lOldNoString, lOldBase, lNewDigits)
fChangeBase = fFromBase10(lBase10Ver, lNewBase, lNewDigits)
End Function
Private Function fToBase10(lOldNoString As String, lBase As Integer,
lNewDigits As String) As Double
' This function takes a string representing a number in base<n>
and returns its base10 equivalent
Dim lPower As Integer
Dim lNewNo As Double
Dim lMulti As Integer
Dim lChar As String
Dim lLengthNo As Integer
Dim lPoint As Integer
Dim x As Long
lLengthNo = Len(lOldNoString)
x = lLengthNo
lPower = 0
lNewNo = 0
' Find the fractional point - if there is one.(The point character
is assumed to be a full stop.)
lPoint = InStr(lOldNoString, ".")
' set the highest power to the length of the integer part of the
number less one.
If lPoint > 0 Then
lPower = lPoint - 2
Else
lPower = lLengthNo - 1
End If
' loop for each 'digit' in the original number from left to right
decreasing the exponent
' by one on each iteration. Find the position of the
corresponding 'digit' in the all-digits list.
' Accumulate the given based raised to this power, times the
position number
' to get the base10 number output.
For x = 1 To lLengthNo
' isolate the next 'digit'
lChar = Mid(lOldNoString, x, 1)
If lChar <> "." Then ' unless this is the decimal point.....
lMulti = InStr(lNewDigits, lChar) ' find the offset
position of the character in the 'digits' string
If lMulti > 0 Then
If lMulti >= lBase Then ' If the 'digit' position is
outside those permitted for number of this base, then the number is
invalid.
MsgBox "Invalid 'digits' for this number base",
vbOKOnly + vbCritical
fToBase10 = 0
Exit Function
End If
lNewNo = lNewNo + ((lBase ^ lPower) * lMulti)
End If
lPower = lPower - 1
End If
Next x
fToBase10 = lNewNo
End Function
Private Function fFromBase10(lBase10No As Double, lNewBase As Integer,
lNewDigits As String) As String
Dim lPower As Integer
Dim lNewNo As String
Dim lDiv As Integer
Dim lBaseXpower As Double
Dim lWork As Double
Dim lRounding As Double
lPower = 0
' find the highest power of the new base that is less than or
equal to the base10
' version of the original number.
Do While lNewBase ^ lPower <= lBase10No
lPower = lPower + 1
Loop
lPower = lPower - 1
' working backwards from the higest divisible power, locate the
'digit' that
' correspons to that divisor. Construct the new number 'digit' by
'digit'
Do While lPower >= 0 Or lBase10No > 0
If lPower = -1 Then ' if this is the 1st fractional place,
then insert a point
lNewNo = lNewNo & "."
End If
lBaseXpower = (lNewBase ^ lPower)
If lPower < 0 Then ' this if clause is to mitigate for the
fact that VBA does not do fractional division accuratly
lRounding = ((lNewBase ^ (lPower - 1)) / 2)
lDiv = Int((lBase10No / lBaseXpower) + lRounding)
If lDiv >= lNewBase Then
lDiv = lDiv - 1
End If
Else
lDiv = Int((lBase10No / lBaseXpower))
End If
If lDiv > 0 Then ' append the relevant 'digit' to the
right-hand end of the number.
lNewNo = lNewNo & Mid(lNewDigits, lDiv, 1)
Else
lNewNo = lNewNo & "0"
End If
lWork = lDiv * lBaseXpower
If lPower <= 0 And lBase10No <= lWork + 9E-17 Then ' the
v.small number added here is once again because VBA fractional
arithmatic is not totally acurate
lBase10No = 0
Else
lBase10No = lBase10No - lWork ' calculate the remaining
part of the input number
End If
lPower = lPower - 1
Loop
fFromBase10 = lNewNo
End Function
developed a VBA / VB function to take a number in any numeric base
and convert it to a number in a different base.
As other people may find this function useful I give it below
(ACB) :-
Public Function fChangeBase(lOldNoString As String, lOldBase As
Integer, lNewBase As Integer) As String
'fCHANGEBASE
' ------------------------------------------------------------------------
' Numeric number base changing function
' by Alan C. Buchanan, Somerset, BA5 1PN, U.K.- September
2003
' ------------------------------------------------------------------------
' Feed a number in any base together with an integer number
indicating the base.
' Also feed a second integer giving the base into which the number
is to be converted.
' The function will return the given number in the new base.
' (The function will handle fractional number (i.e. with a
point).)
'
' Restrictions:-
' a) The order in which the 'digits' in the supplied number string
occur must conform to
' those shown in the lNewDigit string shown below.
' b) As supplied the function handles bases between 2 and 62
' c) The function works by converting the given number to base10
and then converting
' this base10 number to the target base. It follows that the
accuracy of the
' conversion depends on the accuracy of the (double-byte)
base10 arithmetic.
' Accuracy begins to get lost for numbers greater than
999999999999999 .
' d) Fractional arithmetic, the conversion of the fractional part
of any number, may also
' be inaccurate (depending on the two bases involved).
'
' (My understanding is that the IEEE 754 standard imposes a limit
on the accuracy but
' perhaps both these precision problems could be fixed by using a
high precision arithmetic add-in
' like, for example , xlPrecision
(http://precisioncalc.com/What is xlPrecision.html).
' I have not tried such an add-in as including one would mean that
the function would be
' limited to users would had it.)
'
' Usage :-
' You are free to use this function, for personal use and as a
basis for further
' experiment, under General Open Source conditions (GPL).
' If, however, you incorporate it into a commercial product,
please forward a
' suitable contribution for the Buchanan coffers!
Dim lNewDigits As String
Dim lPoint As Integer
Dim lIntegerPart As String
Dim lFractionalPart As String
Dim lBase10Ver As Double
lNewDigits = "123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
If lOldBase < 2 Or lOldBase > 62 Or lNewBase < 2 Or lNewBase > 62
Then
MsgBox "Bases must be between 2 and 62", vbOKOnly +
vbCritical
fChangeBase = 0
Exit Function
End If
lBase10Ver = fToBase10(lOldNoString, lOldBase, lNewDigits)
fChangeBase = fFromBase10(lBase10Ver, lNewBase, lNewDigits)
End Function
Private Function fToBase10(lOldNoString As String, lBase As Integer,
lNewDigits As String) As Double
' This function takes a string representing a number in base<n>
and returns its base10 equivalent
Dim lPower As Integer
Dim lNewNo As Double
Dim lMulti As Integer
Dim lChar As String
Dim lLengthNo As Integer
Dim lPoint As Integer
Dim x As Long
lLengthNo = Len(lOldNoString)
x = lLengthNo
lPower = 0
lNewNo = 0
' Find the fractional point - if there is one.(The point character
is assumed to be a full stop.)
lPoint = InStr(lOldNoString, ".")
' set the highest power to the length of the integer part of the
number less one.
If lPoint > 0 Then
lPower = lPoint - 2
Else
lPower = lLengthNo - 1
End If
' loop for each 'digit' in the original number from left to right
decreasing the exponent
' by one on each iteration. Find the position of the
corresponding 'digit' in the all-digits list.
' Accumulate the given based raised to this power, times the
position number
' to get the base10 number output.
For x = 1 To lLengthNo
' isolate the next 'digit'
lChar = Mid(lOldNoString, x, 1)
If lChar <> "." Then ' unless this is the decimal point.....
lMulti = InStr(lNewDigits, lChar) ' find the offset
position of the character in the 'digits' string
If lMulti > 0 Then
If lMulti >= lBase Then ' If the 'digit' position is
outside those permitted for number of this base, then the number is
invalid.
MsgBox "Invalid 'digits' for this number base",
vbOKOnly + vbCritical
fToBase10 = 0
Exit Function
End If
lNewNo = lNewNo + ((lBase ^ lPower) * lMulti)
End If
lPower = lPower - 1
End If
Next x
fToBase10 = lNewNo
End Function
Private Function fFromBase10(lBase10No As Double, lNewBase As Integer,
lNewDigits As String) As String
Dim lPower As Integer
Dim lNewNo As String
Dim lDiv As Integer
Dim lBaseXpower As Double
Dim lWork As Double
Dim lRounding As Double
lPower = 0
' find the highest power of the new base that is less than or
equal to the base10
' version of the original number.
Do While lNewBase ^ lPower <= lBase10No
lPower = lPower + 1
Loop
lPower = lPower - 1
' working backwards from the higest divisible power, locate the
'digit' that
' correspons to that divisor. Construct the new number 'digit' by
'digit'
Do While lPower >= 0 Or lBase10No > 0
If lPower = -1 Then ' if this is the 1st fractional place,
then insert a point
lNewNo = lNewNo & "."
End If
lBaseXpower = (lNewBase ^ lPower)
If lPower < 0 Then ' this if clause is to mitigate for the
fact that VBA does not do fractional division accuratly
lRounding = ((lNewBase ^ (lPower - 1)) / 2)
lDiv = Int((lBase10No / lBaseXpower) + lRounding)
If lDiv >= lNewBase Then
lDiv = lDiv - 1
End If
Else
lDiv = Int((lBase10No / lBaseXpower))
End If
If lDiv > 0 Then ' append the relevant 'digit' to the
right-hand end of the number.
lNewNo = lNewNo & Mid(lNewDigits, lDiv, 1)
Else
lNewNo = lNewNo & "0"
End If
lWork = lDiv * lBaseXpower
If lPower <= 0 And lBase10No <= lWork + 9E-17 Then ' the
v.small number added here is once again because VBA fractional
arithmatic is not totally acurate
lBase10No = 0
Else
lBase10No = lBase10No - lWork ' calculate the remaining
part of the input number
End If
lPower = lPower - 1
Loop
fFromBase10 = lNewNo
End Function