Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA / VB Numeric base changing function
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%20is%20xlPrecision.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 = "123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmn opqrstuvwxyz" 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Cells are changing format from numeric to date automatically | Excel Discussion (Misc queries) | |||
Data base function | Excel Worksheet Functions | |||
Changing Cell Reference in a macro on global base | Excel Discussion (Misc queries) | |||
Changing cell format - for example text to numeric | Excel Discussion (Misc queries) | |||
CHANGING NUMERIC FIGURES TO WORDS | Excel Worksheet Functions |