[53期国庆附加题] 玩转 N 进制 -----------已结

joforn · 发表于 2009-9-24 10:00

跟贴占位……邮件已发。第二次的稍稍修改了下，请24号晚邮件为准

[ 本帖最后由 joforn 于 2009-9-24 21:09 编辑 ]

biaotiger1 · 发表于 2009-9-24 10:35

邮件已发，查收
多次运行，对话框显示的指数变化较大，就不传图片了

这次不会有“坑”了吧

收到 -ldy

joforn · 发表于 2009-9-24 21:29

邮件已经重发了，请查收。
不过这个题不允许使用API，使得速度上慢了很多，有时间做个速度版试试，看看到底能快多少。呵

收到 -ldy

'ID: Joforn OK +2
Function N2ChrX(ByVal L As Long, ByVal N As Integer) As String
'作用：将Long值转换为 N 进制所表示的字符串
'参数说明 L 要转换的值, N (2-36) 将要使用的进制数
Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Dim I As Long, dNum As Double, dDIV As Double, dMod As Long
Dim sRET As String
If (N < 2) Or (N > Len(Jzs)) Then Exit Function
Select Case N
Case 8: N2ChrX = Oct(L)
Case 10: N2ChrX = L
Case 16: N2ChrX = Hex(L)
Case Else:
sRET = String(32, vbNullChar)
If L < 0 Then
dNum = 2147483648# + (L And &H7FFFFFFF)
Else
dNum = L
End If
Do
If dNum > &H7FFFFFFF Then
I = I + 1
dDIV = Fix(dNum / N)
dMod = dNum - dDIV * N + 1
dNum = dDIV
Mid(sRET, I, 1) = Mid(Jzs, dMod, 1)
Else
L = dNum: dNum = 0
Do
I = I + 1
dMod = (L Mod N) + 1
L = L \ N
Mid(sRET, I, 1) = Mid(Jzs, dMod, 1)
Loop While L > 0
End If
Loop While dNum > 0
N2ChrX = StrReverse(Mid(sRET, 1, I))
End Select
End Function
Function ChrX2N(ByVal S As String, ByVal N As Integer) As Long
'作用：字符串值转换为 N 进制所表示的字符串
'参数说明 S 要转换的N进制字符串, N (2-36) 对S变量进制数的说明
Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Dim I As Long, K As Long, dNum As Double
K = Len(S)
If (N < 2) Or (N > Len(Jzs)) And (K = 0) Then Exit Function
Select Case N
Case 8: ChrX2N = Val("&O" & S)
Case 10: ChrX2N = Val(S)
Case 16: ChrX2N = Val("&H" & S)
Case Else:
S = UCase(S)
For I = 1 To Len(S)
K = InStr(Jzs, Mid(S, I, 1))
Select Case K
Case 1 To N: dNum = dNum * N + K - 1
Case Else: Exit For
End Select
Next I
If dNum > 4294967295# Then
Exit Function
ElseIf dNum > &H7FFFFFFF Then
K = dNum - 2147483648#
ChrX2N = K Or &H80000000
Else
ChrX2N = dNum
End If
End Select
End Function

复制代码

[ 本帖最后由 ldy 于 2009-10-21 17:29 编辑 ]

alzeng · 发表于 2009-9-25 10:45

邮件已发送，请版主查收。

收到 -ldy

'【alzeng】: OK +2
Function N2ChrX(ByVal L As Long, ByVal N As Integer) As String
Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Dim k As Byte, i As Byte, M#
If N = 10 Then
N2ChrX = L
Else
M = (L - 2 ^ 32 * (L < 0)) / 10
i = (M - Int(M / (N / 10)) * N / 10) * 10 Mod N
'用这种折中的方法避开 MOD 不能处理大数的问题，优化后可以完全不用MOD -ldy
Do Until N ^ k / 10 > M
k = k + 1
Loop
N2ChrX = Mid(Jzs, i + 1, 1)
M = M - (i - 1) / 10
For i = 2 To k
N2ChrX = Mid(Jzs, Int((M / N ^ (i - 1)) * 10) Mod N + 1, 1) & N2ChrX
Next
End If
End Function
Function ChrX2N(ByVal S As String, ByVal N As Integer) As Long'思路清晰，正解
Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
S = UCase(S)
Dim i As Byte, M#
If N = 10 Then
ChrX2N = S
Else
For i = 1 To Len(S)
M = M + (InStr(Jzs, Mid$(S, i, 1)) - 1) * N ^ (Len(S) - i)
Next
ChrX2N = M + 2 ^ 32 * (M >= 2 ^ 31)
End If
End Function

复制代码

[ 本帖最后由 ldy 于 2009-10-21 17:30 编辑 ]

trustwxq · 发表于 2009-9-25 18:44

版主好，邮件已发送，谢谢给我们机会练习！
效率指数：23200之内可以结受

效率指数低的时候22，高的时候37，没有超过40，不知到波动为什么这么大！

收到 -ldy

'ID: trustwxq Ok +2
Function N2ChrX(ByVal L As Long, ByVal N As Integer) As String
Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Dim aa As Double, bb As Double, result As String
bb = L
If L < 0 And N <> 10 Then
bb = 4294967296# + L
End If
result = ""
If N <> 10 Then
Do While bb > N
aa = Int(bb / N)
aa = bb - aa * N
bb = Int(bb / N)
result = Mid(Jzs, aa + 1, 1) & result
Loop
End If
If N = 10 Then
result = L
ElseIf bb = N Then
result = "10" & result
Else
result = Mid(Jzs, bb + 1, 1) & result
End If
N2ChrX = result
End Function
Function ChrX2N(ByVal S As String, ByVal N As Integer) As Long
Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
S = UCase(S)
Dim LL1 As Integer, LL2 As Integer, chr1 As String, result2 As Double
If S = "" Then
S = 0
End If
result2 = 0
If N <> 10 Then
For LL1 = 1 To Len(S)
chr1 = Mid(S, LL1, 1)
If Asc(chr1) >= Asc("0") And Asc(chr1) <= Asc("9") Then
LL2 = chr1
ElseIf Asc(chr1) >= Asc("A") And Asc(chr1) <= Asc("Z") Then
LL2 = Asc(chr1) - Asc("A") + 10
End If
' LL2 = InStr(Jzs, chr1) - 1
'有常量不用，却用Asc 舍近求远的做法，改为 LL2 = InStr(Jzs, chr1) - 1 提速1倍 --ldy
result2 = result2 + LL2 * N ^ (Len(S) - LL1)
Next
If result2 > 2147483647 Then
ChrX2N = result2 - 4294967296#
Else
ChrX2N = result2
End If
Else
ChrX2N = --S
End If
End Function

复制代码

[ 本帖最后由 ldy 于 2009-10-21 17:30 编辑 ]

taller · 发表于 2009-9-27 10:47

已经发送邮件，请查收。

另，1楼的“自检”代码中，数组中的最后两个值我觉得应该是下面这样吧

Lrr(1001) = -2147483648#
Lrr(1002) = 2147483647

收到 -谢谢提醒，手误，已在一楼修改 -ldy

'论坛ID: taller ok +2 思路清晰，正解。
' 优化：之前有 Ucase转换，instr函数第三个参数 vbTextCompare 省略掉快一倍以上
Function N2ChrX(ByVal L As Long, ByVal N As Integer) As String
'作用：将double值转换为 N 进制所表示的字符串
'参数说明 L 要转换的值, N (2-36) 将要使用的进制数
Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Dim Num As Double, iMod As Integer, sLen As Integer
If N = 10 Then
N2ChrX = VBA.CStr(L)
Else
Num = L
If L < 0 Then
Num = L + 2 ^ 32
ElseIf L = 0 Then
N2ChrX = "0"
Exit Function
End If
Do While Num > 0
iMod = Num - VBA.Int(Num / N) * N + 1
N2ChrX = VBA.Mid$(Jzs, iMod, 1) & N2ChrX
Num = VBA.Int(Num / N)
Loop
End If
End Function
Function ChrX2N(ByVal S As String, ByVal N As Integer) As Long
'作用：字符串值转换为 N 进制所表示的字符串
'参数说明 S 要转换的N进制字符串, N (2-36) 对S变量进制数的说明
Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Dim iLen As Integer, Num As Double, lbit As Integer
If N = 10 Then
ChrX2N = VBA.CLng(S)
Else
S = VBA.UCase(S): iLen = VBA.Len(S)
For j = 0 To iLen - 1
i = VBA.InStr(1, Jzs, Mid$(S, iLen - j, 1), vbTextCompare) - 1
Num = Num + i * (N ^ j)
Next j
If Num > 2147483647 Then
ChrX2N = Num - 2 ^ 32
Else
ChrX2N = Num
End If
End If
End Function

复制代码

[ 本帖最后由 ldy 于 2009-10-21 17:36 编辑 ]

biaotiger1 · 发表于 2009-9-27 11:10

刚发现一楼代码后面还有一段自检的程序

这两天没时间哦，怕十一还要加班

我的分分哦，离我而去要

biaotiger1 · 发表于 2009-9-28 08:26

重新发送，请斑竹费心审阅

谢谢

自检时间依然不稳定，有时候137.8，有时候173.5，有时候200出头，有时候快300了

收到 -ldy

'论坛ID：biaotiger1 Ok +2 但负数转换太慢
Function N2ChrX(ByVal L As Long, ByVal N As Integer) As String
'作用：将Long值转换为 N 进制所表示的字符串
'参数说明 L 要转换的值, N (2-36) 将要使用的进制数
Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Dim A As Integer, bStr As String, nStr As String, LL As Double
Dim C As Byte, D As Byte, bStr1 As String
If N = 10 Then nStr = L: GoTo 1
If L < 0 Then
'如果为负数，将其转变换为正数
LL = -CDbl(L)
'将正数L转换为二进制
Do
A = LL - 2 * Int(LL / 2)
bStr = Mid(Jzs, A + 1, 1)
nStr = bStr & nStr
LL = Int(LL / 2)
Loop Until LL = 0
'将二进制取反并+1
bStr = "": C = Len(nStr)
For A = C To 1 Step -1
If A = C Then D = 1 Else D = 0
bStr = 1 + D - Mid(nStr, A, 1) & bStr
Next A
bStr = String(32 - C, "1") & bStr
'将其转换为十进制
LL = 0
For A = 1 To 32
LL = LL + Mid(bStr, A, 1) * 2 ^ (32 - A)
Next A
Else
LL = L
End If
'将正数转换为N进制
nStr = "": bStr = ""
Do
A = LL - N * Int(LL / N)
bStr = Mid(Jzs, A + 1, 1)
nStr = bStr & nStr
LL = Int(LL / N)
Loop Until LL = 0
1:
N2ChrX = nStr
End Function
Function ChrX2N(ByVal S As String, ByVal N As Integer) As Long
'作用：转换N进制字符串为 Long值
'参数说明 S 要转换的N进制字符串, N (2-36) 对S变量进制数的说明
Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
'Const MaxLong As Long = 2147483647
S = UCase(S)
Dim bStr As String, nStr As String, LL As Double
Dim C As Integer, D As Byte, A As Byte, B As Byte, L As Long, MaxLong As Long
'将N进制转换为十进制
If N = 10 Then LL = S: GoTo 1
D = Len(S)
For C = 1 To D
A = InStr(1, Jzs, Mid(S, C, 1)) - 1
LL = LL + A * N ^ (D - C)
Next C
MaxLong = 2147483647
If LL > MaxLong Then
'LL为负数
'将ll转换为二进制
Do
A = LL - 2 * Int(LL / 2)
bStr = Mid(Jzs, A + 1, 1)
nStr = bStr & nStr
LL = Int(LL / 2)
Loop Until LL = 0
'反码，补码
bStr = "": D = IIf(InStr(1, nStr, "0") = 0, 32, InStr(1, nStr, "0"))
For C = 32 To D Step -1
If C = 32 Then A = 1 Else A = 0
A = 1 + A - Mid(nStr, C, 1)
bStr = Mid(Jzs, A + 1, 1) & bStr
Next C
'将二进制转换为十进制
LL = 0: C = Len(bStr)
For A = 1 To C
LL = LL + Mid(bStr, A, 1) * 2 ^ (C - A)
Next A
LL = -LL
End If
1:
ChrX2N = LL
End Function

复制代码

[ 本帖最后由 ldy 于 2009-10-21 17:37 编辑 ]

泓() · 发表于 2009-9-28 08:38

原帖由 泓() 于 2009-9-26 19:19 发表
修正了（优化后的）一个bug
请刘版查收

收到 -ldy

'论坛ID：泓() 结果正确，+2 但处理负数效率太低。N10toCX 多余且绕弯
'一个清如水，一个乱如泥，老兄在玩冰火两重天？
Function N10toCX(ByVal L As Long, ByVal N As Integer) As String
'正十进制转 N进制
Dim v As Long
Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
If L = 0 Then N10toCX = 0: Exit Function
Do While L > 0
v = L - Int(L / N) * N + 1
N10toCX = Mid$(Jzs, v, 1) & N10toCX
L = Int(L / N)
Loop
End Function
Function N2ChrX(ByVal L As Long, ByVal N As Integer) As String' 乱，但居然对了，太神奇了
'作用：将Long值转换为 N 进制所表示的字符串
'参数说明 L 要转换的值, N (2-36) 将要使用的进制数
Dim i As Long, j As Long, S As String, t As String, Ls As Long, Ss As String
Dim F As String, Z As String, b As Long, c As Long, d As Long, H() As Variant
Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
If Not (N >= 2 And N <= 36) Then Exit Function
If N = 10 Then N2ChrX = CStr(L): Exit Function '若十进制没必要进一步转化
If L > -1 Then
N2ChrX = N10toCX(L, N)
Exit Function '正十进制转 N进制后直接退出
End If
'------以下代码针对负数转化------
S = N10toCX(2147483647, N) '转化Long最大值2147483647 N进制中的值
Ls = Len(S)
For i = Ls To 1 Step -1
j = j + 1: t = Mid$(S, i, 1)
If InStr(Jzs, t) < N Then Ss = Left(S, Ls - j) & _
Mid$(Jzs, InStr(Jzs, t) + 1, 1) & Application.Rept(0, j - 1): Exit For
Next
If Ss = Empty Then Ss = 1 & Application.Rept(0, Ls)
F = Ss '+1 计算Long最小值 -2147483648 N进制值
L = 2147483647 + L + 1 'L =：原始值L与最小值-2147483648 的相差值(10进制中的相差)
Z = N10toCX(L, N) '十进制中的相差值转为 N进制值
Z = Application.Rept(0, Len(F) - Len(Z)) & Z
'以下代码是N进制的加法运算： N进制相差值 + N进制最小值 = 负十进制L转为 N进制值
ReDim H(0 To Len(F)) As Variant
For i = Len(F) To 1 Step -1
b = InStr(Jzs, Mid$(Z, i, 1)) - 1
c = InStr(Jzs, Mid$(F, i, 1)) - 1
d = b + c + H(i)
If d < N Then
H(i) = Mid$(Jzs, d + 1, 1)
Else
H(i - 1) = d \ N
H(i) = Mid$(Jzs, d Mod N + 1, 1)
End If
Next
S = Empty
For i = 0 To UBound(H)
S = S & H(i)
Next
N2ChrX = S
End Function
Function ChrX2N(ByVal S As String, ByVal N As Integer) As Long '这个思路清晰，正解，上面的咋那么乱？
'作用：字符串值转换为 N 进制所表示的字符串
'参数说明 S 要转换的N进制字符串, N (2-36) 对S变量进制数的说明
Dim i As Long, v As Double, Ls As Long, im As Long
Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
S = UCase(S)
If Not (N >= 2 And N <= 36) Then Exit Function
If N = 10 Then ChrX2N = CLng(S): Exit Function
Ls = Len(S)
For i = Ls To 1 Step -1
im = InStr(Jzs, Mid$(S, i, 1))
If im = 0 Then Exit Function
v = v + (im - 1) * N ^ (Ls - i)
Next
If v > 2147483647 Then v = v - 2147483648# * 2
ChrX2N = v
End Function

复制代码

[ 本帖最后由 ldy 于 2009-10-21 17:38 编辑 ]

smhf_6 · 发表于 2009-9-29 23:07

版主：我赶了一个末班车，2009.9.29 23：07发出
请查收
您的所有要求我全部测试正确，包括边界值

[ 本帖最后由 smhf_6 于 2009-9-29 23:10 编辑 ]
Function N2ChrX(ByVal L As Long, ByVal N As Integer) As String  ' 10进制->n进制
'作用：将Long值转换为 N 进制所表示的字符串，Long 值范围（-2147483648  到 2147483647）
'参数说明 L 要转换的值, N (2-36) 将要使用的进制数
   Dim I As Integer
   Dim res As Integer
   Dim S As String
   Dim sb
   Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
If N = 10 Then
S = L
Else
   If L > 0 Then
      Do While L <> 0
      res = L Mod N
      S = Mid(Jzs, res + 1, 1) & S
      L = L \ N
      Loop
   ElseIf L = 0 Then
      S = 0
   Else
      sb = 2 ^ 32 + L

      Do While sb <> 0
      res = sb - Int(sb / N) * N
      S = Mid(Jzs, res + 1, 1) & S
      sb = Int(sb / N)
      Loop
End If
End If
N2ChrX = S

End Function

Function ChrX2N(ByVal S As String, ByVal N As Integer) As Long  'n进制->10进制
'作用：字符串值转换为 N 进制所表示的字符串
'参数说明 S 要转换的N进制字符串, N (2-36) 对S变量进制数的说明
   Dim I As Integer
   Dim ml As Long
   Dim mml
   Dim res As Integer
   Dim sb
   Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   S = UCase(S)
  If N = 10 Then
  ml = S
  Else

   If S = "0" Then
   ml = 0
   Else
   For I = 1 To Len(S)
   mml = mml + (InStr(Jzs, Mid(S, I, 1)) - 1) * N ^ (Len(S) - I)

   Next
      If mml <= 2147483647 Then
      ml = mml
      Else
      ml = mml - 2 ^ 32
      End If
   End If
End If
ChrX2N = ml          '

End Function

没有收到，你可以发短信给我 -ldy  2009-9-30

[ 本帖最后由 smhf_6 于 2009-10-21 19:52 编辑 ]

		自动登录	找回密码
密码			免费注册

[Excel 程序开发] [53期国庆附加题] 玩转 N 进制 -----------已结

评分

评分

评分

评分

本帖子中包含更多资源

评分

评分

评分