Страницы: 1
RSS
Пользовательская функция для перевода из различных систем счисления
 
В прикреплённом примере находится пользовательская функция для перевода из(в) различных систем счисления.
Штатными функциями Excel достаточно просто переводить числа из десятичной, двоичной, восьмеричной и шестнадцатеричной систем.
Для перевода, например, из 17-ричной в 23-ричную можно воспользоваться этой функцией. (Не спрашивайте меня "зачем?" :)

Код может работать с "условно" бесконечными системами.
Сейчас в коде максимальная система с основанием 35.
Для увеличения основания, дополните массив c = Array("0", ... значениями требуемой системы.
Код
Function СистемаСчисления(Число As String, Optional СистемаИз As Byte = 10, Optional СистемаВ As Byte = 10)
    Dim d As Double
    Dim i As Integer
    Dim s As String
    Dim c As Variant
    Dim z As Long
    Dim k As Byte
    
    c = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
    
    If Число = "0" Then
       СистемаСчисления = "0"
    Else
        'преобразование цифры в число
        d = 0
        For i = 1 To Len(Число)
            s = Mid(UCase(Число), i, 1)
            
            k = 0
            Do
                If s = c(k) Then
                    d = d + k * СистемаИз ^ (Len(Число) - i)
                    Exit Do
                End If
                k = k + 1
                If k > UBound(c) Then Exit Do
            Loop
        Next
        
        'преобразование числа в цифру
        s = ""
        For i = Val(Log(d) / Log(СистемаВ)) To 0 Step -1
            z = СистемаВ ^ i
            k = Val(d / z)
            
            s = s & c(k)
            d = d - k * z
        Next
        
        СистемаСчисления = s
    End If
End Function
 
1.
Цитата
МатросНаЗебре написал: i = Val(Log(d) / Log(СистемаВ))
k = Val(d / z)
МатросНаЗебре, для чего здесь Val, может нужно Int или Fix?
2.
Цитата
If k > UBound© Then Exit Do            
Loop
Разве не проще написать
Код
Loop Until k > UBound(c) 

3. что делать с числами, которые не убираются в тип Double без потери точности?
4.
Цитата
Штатными функциями Excel...
В штатных функциях есть еще параметр - разрядность (длина выходного числа)
Изменено: MCH - 31.01.2017 22:33:28
 
MCH,
По 3 - при тестировании ошибок не нашёл. Не исключаю, что при определённых условиях неточность может возникать.
По 4 - решил обойтись без этого, для упрощения пользования функцией.
По 1 и 2 - согласен.

to all
У функции есть одна "недокументированная фича". Обработка ошибок неправильного ввода. Если во входной строке есть символы, которых не должно быть в используемой системе, например 2 в двоичной системе, то функция правильно отрабатывает эту нештатную ситуацию. Получилось случайно, решил не убирать, так more user friendly :)
 
Тема по переводу из одной системы в другую уже поднималась, и есть решения для длинных чисел:
http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=76392
 
А можно добавить в функцию обработку вещественных чисел?
Для упрощения оставить только из 10 в 2 ую систему

Пример ручного перевода в файле.
Изменено: Marat Ta - 19.02.2021 15:00:16
 
Можно и для вещественных.
Код
Function СистемаСчисления(Число As String, Optional СистемаИз As Byte = 10, Optional СистемаВ As Byte = 10)
    Dim d As Double
    Dim i As Integer
    Dim s As String
    Dim c As Variant
    Dim z As Long
    Dim k As Byte
    Dim dr As Double
    Dim da As Double
    Dim sd As String
     
    c = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
     
    If Число = "0" Then
       СистемаСчисления = "0"
    Else
        i = InStr(Число, Application.DecimalSeparator)
        If i > 0 Then
            sd = Mid(Число, i + 1)
            'Число = Left(Число, i - 1)
            Число = Replace(Число, Application.DecimalSeparator, "")
        End If
        
        'преобразование цифры в число
        d = 0
        For i = 1 To Len(Число)
            s = Mid(UCase(Число), i, 1)
             
            k = 0
            Do
                If s = c(k) Then
                    d = d + k * СистемаИз ^ (Len(Число) - i)
                    Exit Do
                End If
                k = k + 1
                If k > UBound(c) Then Exit Do
            Loop
        Next
        
        'Дробная часть
        If sd <> "" Then
            da = d
            da = da / ((СистемаИз * 1) ^ (Len(sd)))
            d = Int(da)
            dr = da - d
        End If
        
        'преобразование числа в цифру
        If d <> 0 Then
            s = ""
            For i = Val(Log(d) / Log(СистемаВ)) To 0 Step -1
                z = СистемаВ ^ i
                k = Val(d / z)
                 
                s = s & c(k)
                d = d - k * z
            Next
        Else
            s = "0"
        End If
         
        'Дробная часть
        If sd <> "" Then
            sd = Application.DecimalSeparator
            For i = 1 To 15
                dr = dr * СистемаВ
                sd = sd & Int(dr)
                dr = dr - Int(dr)
                If dr < 0.00000000000001 Then Exit For
            Next
        End If
         
        СистемаСчисления = s & sd
    End If
End Function
 
я когда-то давно написал и публиковал тут две функции
Код
' из 10-ричной системы в x/з какую
Function D2xz(d, xz As Long) As String
  Const ch$ = "0 1 2 3 4 5 6 7 8 9 A B C D E F G H I J K L M N O P Q R S T U V W X Y Z"
  Dim r%, D2C
  r = Int(Round(Log(d) / Log(xz), 7)): D2C = Split(ch)
  Do
    D2xz = D2xz & D2C(Int(d / xz ^ r)): d = d - Int(d / xz ^ r) * xz ^ r: r = r - 1
  Loop Until r = -1
End Function
' и обратно
Function xz2D(s As String, xz As Long)
  Dim r%
  For r = 0 To Len(s) - 1
    xz2D = xz2D + (InStr("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ", Mid(s, Len(s) - r, 1)) - 1) * xz ^ r
  Next
End Function

соотв. если перевести 5G из 17 в 23:
D2xz(xz2D("5G",17),23) - получим 49
Изменено: Ігор Гончаренко - 19.02.2021 19:51:56
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
МатросНаЗебре, все работает отлично. Спасибо.

Можно добавить в макрос:
1) кол-во знаков после запятой на выходе (с округлением или нет - на ваше усмотрение)
2) обработку входных данных с ".", например 10000.100011
Изменено: Marat Ta - 03.03.2021 14:49:11
 
del
Изменено: Marat Ta - 21.02.2021 15:45:31
 
Некорректно выводится результат по 16ой системе. Перевод 127.37 из 10чной в 16чную - после запятой нет ABCDE.... только 0...9
Изменено: Marat Ta - 21.02.2021 16:50:05
Страницы: 1
Наверх