Конвертирует десятичные целые числа в шестнадцатиричные. Работает разумеется дольше штатной. Максимально способна обрабатывать 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, Ну понятное дело что на просторах инета полно реализаций, но вопрос, почему такой подход перевода, почему не http://matworld.ru/calculator/perevod-chisel.php штатное рекурсивное деление и остаток в качестве результата с последующим перевдом в 0-F полученного разряда?
Anchoret, алгоритмы на VBA отметил Михаил, а продвинутые здесь. Функция Convert в разделе BignumArithmeticInteger в стандартном менеджере функций Excel. 32 тысячу знаков (мах для ячейки) переводит за долю секунды из одной базы счисления в другую по основаниям от 2 до 36.
Совокупное количество итераций меньше. Ну или мне кажется, что меньше. В моем варианте число делится на байты (т.е. на восемь бит), что всяко быстрее, чем делить рекурсивно или еще как исходное число на 16. Максимальное 6-ти байтовое число - 2814749767110650, устанем ждать результатов деления.
На просторы инета особо не смотрел, было интересно самому реализовать)
П.С.: Понятно, что реализовывать всякие мудреные алгоритмы на VBA - дело сомнительной пользы. Но иногда хочется, хотя бы для тренировки мозга) Помогая на форуме большой загрузки на серое вещество нет. "Скопировать строки по определенному критерию с одного листа на другой", "размножить листы", "поудалять строки/столбцы/листы/книги/etc" и прочие подобные вводят в тоску и уныние ----------------- Более компактный вариант:
Скрытый текст
Код
Function DecHexConvPlus$(ByVal Num)
Dim aa, c%, nn, dt$, d%
aa = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F")
'-------------------------
On Error Resume Next
Num = Fix(CDec(Num))
If Err.Number <> 0 Then Err.Clear: DecHexConvPlus = "#Err": Exit Function
dt = "#": 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
dt = dt & aa(((nn And 240) / 16)) & aa((nn And 15))
nn = Num
Loop
Do While d > 1
dt = dt & "00": d = d - 1
Loop
dt = dt & aa(((nn And 240) / 16)) & aa((nn And 15))
'---------------------------
DecHexConvPlus = dt
End Function
Anchoret написал: Совокупное количество итераций меньше.
Количетсво итераций = количеству итоговых разрядов 281474976710655=FFFFFFFFFFFF, то есть в данном случае делим на 16 12 раз , чтоб показать реверс, уменьшил на 1. Мне кажется сложного ничего нет.
Но в одном вы однозначно правы,
Цитата
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)) определяет разряднось будущего числа
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
и вот проверочная функция, которая переводит обратно из хз в десятичную
Код
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
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
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 с длинной арифметикой.
Если ограничиться диапазоном положительных чисел 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