Страницы: 1
RSS
Пользовательская функция-аналог Hex (10-16) для больших чисел
 
Возможно будет кому полезна)

Конвертирует десятичные целые числа в шестнадцатиричные.
Работает разумеется дольше штатной.
Максимально способна обрабатывать 6-ти байтовые числа, после (из-за ограничения в Excel на количество цифр в числе) начинает выдавать фигню.

П.С.: Было бы интересно глянуть на более продвинутые варианты сего действа :)
Код
Function DecHexConv$(ByVal Num)
Dim aa, b%, c%, nn, cc$(), d%
aa = Array("A", "B", "C", "D", "E", "F")
'-------------------------
On Error Resume Next
Num = Fix(CDec(Num))
If Err.Number <> 0 Then Err.Clear: DecHexConv = "#Err": Exit Function
ReDim cc(0 To 0): b = 0: nn = Num
Do While Num / 255 > 1
  c = 1
  Do While nn > 255
    nn = Fix(nn / 256): c = c + 1
  Loop
  Num = Num - (nn * (256 ^ (c - 1))): d = c - 1
  If (nn And 240) / 16 > 9 Then cc(b) = aa(((nn And 240) / 16) - 10) Else cc(b) = CStr((nn And 240) / 16)
  If (nn And 15) > 9 Then cc(b) = cc(b) & aa((nn And 15) - 10) Else cc(b) = cc(b) & (nn And 15)
  nn = Num: b = b + 1: ReDim Preserve cc(0 To b)
Loop
Do While d > 1
  cc(b) = "00": d = d - 1: b = b + 1: ReDim Preserve cc(0 To b)
Loop
If (nn And 240) / 16 > 9 Then cc(b) = aa(((nn And 240) / 16) - 10) Else cc(b) = CStr((nn And 240) / 16)
If (nn And 15) > 9 Then cc(b) = cc(b) & aa((nn And 15) - 10) Else cc(b) = cc(b) & (nn And 15)
'---------------------------
DecHexConv = "#" & Join(cc, "")
End Function
Изменено: Anchoret - 20.04.2018 09:23:22
 
для длинных чисел было здесь
 
Anchoret, Ну понятное дело что на просторах инета полно реализаций, но вопрос, почему такой подход перевода, почему не http://matworld.ru/calculator/perevod-chisel.php штатное рекурсивное деление и остаток в качестве результата с последующим перевдом в 0-F полученного разряда?
По вопросам из тем форума, личку не читаю.
 
Anchoret,  алгоритмы на VBA отметил Михаил, а продвинутые здесь. Функция  Convert в разделе BignumArithmeticInteger в стандартном менеджере функций Excel. 32 тысячу знаков (мах для ячейки) переводит за долю секунды из одной базы счисления в другую по основаниям от 2 до 36.
«Бритва Оккама» или «Принцип Калашникова»?
 
Цитата
БМВ написал:
почему такой подход перевода
Совокупное количество итераций меньше. Ну или мне кажется, что меньше. В моем варианте число делится на байты (т.е. на восемь бит), что всяко быстрее, чем делить рекурсивно или еще как исходное число на 16. Максимальное 6-ти байтовое число - 2814749767110650, устанем ждать результатов деления.

На просторы инета особо не смотрел, было интересно самому реализовать)

bedvit, гляну, спасибо.
MCH, спасибо, я видел)

П.С.: Понятно, что реализовывать всякие мудреные алгоритмы на VBA  - дело сомнительной пользы. Но иногда хочется, хотя бы для тренировки мозга) Помогая на форуме большой загрузки на серое вещество нет. "Скопировать строки по определенному критерию с одного листа на другой", "размножить листы", "поудалять строки/столбцы/листы/книги/etc" и прочие подобные вводят в тоску и уныние :)
-----------------
Более компактный вариант:
Скрытый текст
Тайминги (старый, новый):
Код
 1000000       20,945
 1000000       17,562
-
Изменено: Anchoret - 20.04.2018 10:25:10
 
Цитата
Anchoret написал:
Совокупное количество итераций меньше.
Количетсво итераций = количеству итоговых разрядов 281474976710655=FFFFFFFFFFFF, то есть в данном случае делим на 16  12 раз , чтоб показать реверс, уменьшил на 1. Мне кажется сложного ничего нет.


Но в одном вы однозначно правы,
Цитата
Anchoret написал:
Но иногда хочется, хотя бы для тренировки мозга)
Это никому не вредило.
По вопросам из тем форума, личку не читаю.
 
БМВ,видимо у меня мозг-мазохист и всегда идет от сложного к простому) Сначала нагорожу кода, что потом сам с трудом понимаю что и где, а потом идет поэтапная оптимизация...
 
Anchoret, Уверяю, это не самый плохой вариант, хуже когда
Цитата
Anchoret написал:
Сначала нагорожу кода
и на этом останавливаются, пуская в продуктив.
По вопросам из тем форума, личку не читаю.
 
написано много лет назад, я публиковал уже здесь:
Код
Function D2xz(d, N 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(N), 7)): D2C = Split(ch)
  Do
    D2xz = D2xz & D2C(Int(d / N ^ r)): d = d - Int(d / N ^ r) * N ^ r: r = r - 1
  Loop Until r = -1
End Function
D2xz - переводит число из 10-й в какую-то N-ю систему
для перевода в 16-ю пишите вторым параметром 16 (N допустимо от 2 (двоичная) до 36)))
это
r = Int(Round(Log(d) / Log(N), 7))
определяет разряднось будущего числа
Изменено: Ігор Гончаренко - 20.04.2018 13:43:04
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко,  А зачем r?
Код
Function D2xz(d, N As Long) As String
  Dim M As Integer
  Do
    M = d Mod N
    D2xz = IIf(M < 10, M, Chr(55 + M)) & D2xz
    d = Int(d / N)
  Loop Until d < N
    D2xz = IIf(d < 10, d, Chr(55 + d)) & D2xz
End Function
По вопросам из тем форума, личку не читаю.
 
допустим d = 1E+13
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
и вот проверочная функция, которая переводит обратно из хз в десятичную
Код
Function xz2D(s As String, N As Long)
  Dim r%
  For r = 0 To Len(s) - 1
    xz2D = xz2D + (InStr("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ", Mid(s, Len(s) - r, 1)) - 1) * N ^ r
  Next
End Function
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
Ігор Гончаренко написал:
допустим d = 1E+13
про большие уже и забыл :-)

для сверхдлинных нет но для разумных
Код
Function D2xz(d, N As Long) As String
  Dim M As Integer
  Do
    M = d - Int(d / N) * N
    D2xz = IIf(M < 10, M, Chr(55 + M)) & D2xz
    d = Int(d / N)
  Loop Until d < N
    D2xz = IIf(d < 10, d, Chr(55 + d)) & D2xz
End Function
для интереса взглянул, принцип то тот что у MCH с длинной арифметикой.
Изменено: БМВ - 20.04.2018 14:39:22
По вопросам из тем форума, личку не читаю.
 
Ігор Гончаренко, БМВ, спасибо за Ваши варианты решений :)
 
Если ограничиться диапазоном положительных чисел Decimal, можно просто перенести его двоичное представление в 3 переменных типа Long и использовать штатную функцию Hex
Код
Declare Sub RtlMoveMemory Lib "kernel32" (dst As Any, src As Any, ByVal bytes As Long)

Function HexD(ByVal x) As String
Dim L1&, L0&, L2&, flags&
  x = CDec(x)
  RtlMoveMemory flags, x, 16
  HexD = Hex(L0)
  If L1 Or L2 Then
    HexD = Hex(L1) & String$(8 - Len(HexD), "0") & HexD
    If L2 Then HexD = Hex(L2) & String$(16 - Len(HexD), "0") & HexD
  End If
End Function
тесты
Код
?hexd(0)
0
?hexd(2^32-1)
FFFFFFFF
?hexd(2^32+1)
100000001
?hexd(2^64)
1000000000000BD00
?hexd(2^95)
8000000000001C6111528000
?hexd(2^96-2^43)
FFFFFFFFFFFFDDCF122AC000
?hexd("79228162514264337593543950335")
FFFFFFFFFFFFFFFFFFFFFFFF
 
Казанский, большое спасибо за интересный вариант! Похоже, что пора начать знакомство с WinAPI, а возможно и не только с ним)
Страницы: 1
Наверх