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

biaotiger1 · 发表于 2009-9-30 09:04

哈
佳节将至，刘版送分
谢谢斑竹，礼物收到

要知道我的第一版效率指数696呢

第二个小板凳虽然不好，但比第一个好多了

在鼓励自己的时候也不的不承认——差距还是很大滴，我对算法方面的考虑太少

incognito · 发表于 2009-9-30 09:14

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

[ 本帖最后由 incognito 于 2009-9-30 09:15 编辑 ]

收到，但未按题目要求答题，时间还早，请按统一格式答题-ldy

'Excel Home ID: incognito 结果正确，但未按题目要求答题不评分
'=================================================================
Function N2ChrX(ByVal L As Variant, N As Integer) _
As String
Const sDigits As String = "123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Const MaxLen = 56
Dim sNumber As String
Dim p As Integer
Dim iDigit As Integer
Dim PrevValue As Variant
If N = 10 Then
N2ChrX = L
Exit Function
End If
If L < 0 Then
L = L + 4294967296#
End If
sNumber = String$(MaxLen, "0")
p = MaxLen + 1
Do While L > 0
PrevValue = L
L = Int(L / N)
iDigit = PrevValue - L * N
p = p - 1
If iDigit Then Mid$(sNumber, p, 1) = Mid$(sDigits, iDigit, 1)
Loop
If p > MaxLen Then p = p - 1
N2ChrX = Mid$(sNumber, p)
End Function
'**************************************************************************************************
Function ChrX2N(ByVal L As String, ByVal N As Integer) As Variant
Dim index As Long
Dim digits As String
Dim digitValue As Variant
Const sDigits As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
If N < 2 Or N > 36 Then Err.Raise 5
digits = Left(sDigits, N)
If N = 10 Then
ChrX2N = L
Exit Function
End If
For index = 1 To Len(L)
digitValue = InStr(1, digits, Mid$(L, index, 1), _
vbTextCompare) - 1
If digitValue < 0 Then Exit Function
ChrX2N = ChrX2N * N + digitValue
Next
If ChrX2N > 2147483647# Then
ChrX2N = ChrX2N - 4294967296#
End If
End Function

复制代码

结果正确，但未按题目要求答题，并且抄袭痕迹太明显，不予评分。
参考 http://www.keyongtech.com/957569-convert-a-nine-digit-number

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

蓝桥玄霜 · 发表于 2009-10-2 16:51

占位。邮件已发，请查收。
国庆快乐！

'ID:蓝桥玄霜结果正确，但负数转换太慢，影响整个速度 + 2
Function N2ChrX(ByVal L As Long, ByVal N As Integer) As String
'作用：将Long值转换为 N 进制所表示的字符串
'参数说明 L 要转换的值, N (2-36) 将要使用的进制数
Dim iMod As Integer, dInt As Double, sChar As String
Dim ws&, fws&, zxx, i&, j&, nf$, bb$, a$, a1$, a2$, b, wc, w&, j1
Dim wszd&, wszx&, jw&, zdzf$, s1, n2, c, c1, n1
Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Const zd& = 2147483647
Const zx& = -2147483648#
If N = 10 Then N2ChrX = L: Exit Function
If L = 0 Then N2ChrX = L: Exit Function
If L > 0 Then
iMod = L Mod N
dInt = Int(L / N)
If iMod > 0 Then
sChar = Mid$(Jzs, iMod + 1, 1)
ElseIf dInt > 0 Then
sChar = "0"
End If
Do While dInt > 0
iMod = dInt Mod N
dInt = Int(dInt / N)
If iMod > 0 Then
sChar = Mid$(Jzs, iMod + 1, 1) & sChar
ElseIf dInt > 0 Then
sChar = "0" & sChar
End If
Loop
Else
zdzf = N2ChrX(zd, N)
wszd = Len(zdzf)
If L = zd Then N2ChrX = zdzf: Exit Function
jw = 1: i = wszd 'zdzf+1求得最小值zxx
Do While jw = 1 And i > 0
a = Mid$(zdzf, i, 1)
n2 = InStr(Jzs, a) - 1
c = n2 + 1
If c < N Then
c1 = Mid$(Jzs, c + 1, 1)
s1 = c1 & s1
zxx = Left$(zdzf, i - 1) & s1
GoTo 150
Else
c1 = "0"
s1 = c1 & s1
i = i - 1
End If
Loop
If N = 2 Then zxx = "1" & s1
150:
wszx = Len(zxx)
wc = wszx - wszd
If wc > 0 Then
zdzf = Application.Rept("0", wc) & zdzf
End If
jw = 0: s1 = "" 'zdzf+zxx求得f1(-1)
For i = wszx To 1 Step -1
a = Mid$(zdzf, i, 1)
n2 = InStr(Jzs, a) - 1
b = Mid$(zxx, i, 1)
n1 = InStr(Jzs, b) - 1
c = n2 + n1
If jw = 1 Then
c = c + 1
End If
If c < N Then
c1 = Mid$(Jzs, c + 1, 1)
jw = 0
ElseIf c = N Then
c1 = "0"
jw = 1
Else
c = c Mod N
c1 = Mid$(Jzs, c + 1, 1)
jw = 1
End If
s1 = c1 & s1
Next i
If jw = 1 Then
s1 = "1" & s1
End If
f1 = s1
If L = zx Then
N2ChrX = zxx
Exit Function
ElseIf L = -1 Then N2ChrX = f1: Exit Function
Else
L = -L - 1
End If
ws1 = Len(f1)
nf = N2ChrX(L, N) '求得正的L－1的代码
fws = Len(nf)
wc = ws1 - fws
If wc > 0 Then
nf = Application.Rept("0", wc) & nf
End If
jw = 0: s1 = ""
For i = ws1 To 1 Step -1
a = Mid$(f1, i, 1)
n2 = InStr(Jzs, a) - 1
b = Mid$(nf, i, 1)
n1 = InStr(Jzs, b) - 1
c = n2 - n1
If c >= 0 Then
If jw = 1 Then
c = c - 1
If c >= 0 Then
If i = 1 And c = 0 And jw = 1 Then sChar = s1: GoTo 300
c1 = Mid$(Jzs, c + 1, 1)
s1 = c1 & s1
jw = 0
Else
c = c + N + 1
c1 = Mid$(Jzs, c, 1)
jw = 1
s1 = c1 & s1
End If
Else
c1 = Mid$(Jzs, c + 1, 1)
s1 = c1 & s1
jw = 0
End If
Else
c = c + N + 1
If jw = 1 Then c = c - 1
c1 = Mid$(Jzs, c, 1)
jw = 1
s1 = c1 & s1
End If
Next i
If jw = 1 Then
c = c - 1
c1 = Mid$(Jzs, c + 1, 1)
s1 = c1 & s1
End If
sChar = s1
End If
300:
N2ChrX = sChar
End Function
Function ChrX2N(ByVal S As String, ByVal N As Integer) As Long
'作用：字符串值转换为 N 进制所表示的字符串
'参数说明 S 要转换的N进制字符串, N (2-36) 对S变量进制数的说明
Dim ws&, fws&, i&, j&, j1, a$, b$, sChar$, suz, zxx
Dim fs&, zdzf, wszd&, wszx&, c, s1, c1, n2, n1, f1$, jw&
Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Const zd& = 2147483647
Const zx& = -2147483648#
If N = 10 Then ChrX2N = S: Exit Function
S = UCase(S)
ws = Len(S)
'判断正负数
If N = 16 And Left$(S, 1) > "7" And ws = 8 Then
fs = 1: GoTo 100
ElseIf N = 16 And ws < 8 Then
GoTo 200
End If
100:
zdzf = N2ChrX(zd, N)
wszd = Len(zdzf)
If ws < wszd Then
GoTo 200
ElseIf ws = wszd Then
If S > zdzf Then fs = 1: GoTo 120
GoTo 200
Else
fs = 1
End If
120:
'是负数时，执行下面代码
If S = zdzf Then ChrX2N = zd: Exit Function
If S = "0" Then ChrX2N = S: Exit Function
jw = 1: i = wszd 'zdzf+1求得最小值zxx
Do While jw = 1 And i > 0
a = Mid$(zdzf, i, 1)
n2 = InStr(Jzs, a) - 1
c = n2 + 1
If c < N Then
c1 = Mid$(Jzs, c + 1, 1)
s1 = c1 & s1
zxx = Left$(zdzf, i - 1) & s1
GoTo 150
Else
c1 = "0"
s1 = c1 & s1
i = i - 1
End If
Loop
If N = 2 Then zxx = "1" & s1
150:
wszx = Len(zxx)
wc = wszx - wszd
If wc > 0 Then
zdzf = Application.Rept("0", wc) & zdzf
End If
jw = 0: s1 = "" 'zdzf+zxx求得f1(-1)
For i = wszx To 1 Step -1
a = Mid$(zdzf, i, 1)
n2 = InStr(Jzs, a) - 1
b = Mid$(zxx, i, 1)
n1 = InStr(Jzs, b) - 1
c = n2 + n1
If jw = 1 Then
c = c + 1
End If
If c < N Then
c1 = Mid$(Jzs, c + 1, 1)
jw = 0
ElseIf c = N Then
c1 = "0"
jw = 1
Else
c = c Mod N
c1 = Mid$(Jzs, c + 1, 1)
jw = 1
End If
s1 = c1 & s1
Next i
If jw = 1 Then
s1 = "1" & s1
End If
f1 = s1
If S = f1 Then ChrX2N = "-1": Exit Function
If S = zxx Then ChrX2N = zx: Exit Function
ws1 = Len(f1)
wc = ws1 - ws
If wc > 0 Then
S = Application.Rept("0", wc) & S
End If
jw = 0
For i = ws1 To 1 Step -1 '－1减S的代码
a = Mid$(f1, i, 1)
n2 = InStr(Jzs, a)
b = Mid$(S, i, 1)
n1 = InStr(Jzs, b)
c = n2 - n1
If jw = 1 Then
c = c - 1
If i = 1 And c = 0 Then jw = 0: Exit For
If c >= 0 Then
jw = 0
Else
c = c + N
jw = 1
End If
ElseIf c < 0 Then
c = c + N
jw = 1
End If
suz = suz + c * N ^ m
m = m + 1
Next i
If jw = 1 Then
c = c - 1
suz = suz + c * N ^ m
End If
GoTo 300
200:
For i = ws To 1 Step -1
a = Mid$(S, i, 1)
If a <> "0" Then
b = InStr(Jzs, a) - 1
suz = suz + b * N ^ m
End If
m = m + 1
Next i
300:
If fs = 0 Then
ChrX2N = suz
Else
ChrX2N = -suz - 1
End If
End Function

复制代码

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

ldy · 发表于 2009-10-21 18:39

EXCEL26进制来回转换和玩转N进制两道VBA题目及其类似，放到一起做为结贴
http://club.excelhome.net/viewth ... p;page=4#pid3244334

香川群子 · 发表于 2010-9-2 12:57

学习之。

负数规律算明白了。
-2147483647～-1
加上2^32转换为正数，
2147483649～4294967295
再进行进制计算……
非10进制的负数显得比正数还要大。

小数规律不清楚。

[ 本帖最后由香川群子于 2010-9-2 16:53 编辑 ]

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

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

评分

结贴

浏览过的版块