[第53期]EXCEL26进制来回转换 ---------已结

biaotiger1 · 发表于 2009-9-22 08:00

邮件今天凌晨已经发送
望查收

——别人的电脑是电脑，偶的电脑咋就是牛车捏

收到 ——ldy

'论坛ID：biaotiger1 ok +3
'Option Explicit
Function N2Char26R(ByVal L As String) As Double
'你的代码要求EXCEL2003下可运行
'要求不仅限于 2003的IV（256) 和 2007 的XFD（16384列）
'具体要求请运行验证1
Dim N As Double, K As Byte, I As Byte, C As Integer
C = Len(L)
For I = 1 To C
K = Asc(UCase(Mid(L, I, 1))) - 64
N = N + K * 26 ^ (C - I)
Next
N2Char26R = N
End Function
Function N2Char26(ByVal L As Double) As String
'你的代码要求EXCEL2003下可运行
'具体要求请运行验证2
Dim iMod As Integer, sChar As String, K As Integer, X As Integer
Dim Temp As Double, M As Double
iMod = Int(WorksheetFunction.Log(L, 26))
For X = iMod To 0 Step -1
K = Int(L / 26 ^ X)
Temp = K * 26 ^ X
For M = 0 To X - 1
Temp = Temp + 26 ^ M
Next M
If Temp > L Then
K = IIf(Int(L / 26 ^ X) = 1, 0, K - 1)
End If
L = L - K * 26 ^ X
sChar = sChar & Chr(K + 64)
Next
sChar = IIf(Left(sChar, 1) = "@", Right(sChar, Len(sChar) - 1), sChar)
N2Char26 = sChar
End Function

复制代码

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

lipton · 发表于 2009-9-22 08:04

信已发，请版主查收。

收到 ——ldy

'论坛ID lipton 26的整倍数未通过验证(26=AD ?) +1 补票 +1
Function N2Char26R(ByVal L As String) As Double
Dim iMod As Integer, dInt As Double
Dim i As Byte
Dim d1 As Double, d2 As Double
Dim s1 As String
iMod = Len(L)
dInt = 0
d2 = iMod - 1
For i = 1 To iMod
s1 = StrConv(Mid(L, i, 1), 1)
d1 = Asc(s1) - 64
dInt = dInt + d1 * (26 ^ d2)
d2 = d2 - 1
Next
N2Char26R = dInt
End Function
Function N2Char26(L As Double) As String' 第二次答案正确
Dim iMod As Double, dInt As Double, sChar As String
Dim dblA As Double
dInt = L
If dInt = 0 Then
N2Char26 = ""
Exit Function
End If
Do
iMod = dInt - Fix(dInt / 26) * 26
dInt = Fix(1 / 26 * dInt)
If iMod > 0 Then
sChar = Chr(iMod + 64) & sChar
ElseIf dInt > 0 Then
dInt = dInt - 1
sChar = "Z" & sChar
End If
Loop While dInt > 0
N2Char26 = sChar
End Function
Function N2Char26(L As Double) As String' 第一次答案 26的整倍数未通过验证(26=AD ?) +1
Dim iMod As Double, dInt As Double, sChar As String
Dim dblA As Double
iMod = (((L / 10) Mod 26) * 10) Mod 26
dInt = Fix(1 / 26 * L)
If iMod > 0 Then
sChar = Chr(iMod + 64)
ElseIf dInt > 0 Then
dInt = dInt - 1
sChar = "Z"
End If
Do While dInt > 0
iMod = dInt Mod 26
dInt = Fix(1 / 26 * dInt)
If iMod > 0 Then
sChar = Chr(iMod + 64) & sChar
ElseIf dInt > 0 Then
dInt = dInt - 1
sChar = "Z" & sChar
End If
Loop
N2Char26 = sChar
End Function

复制代码

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

第Ⅸ夜 · 发表于 2009-9-22 14:02

已经重新发送！

[ 本帖最后由第Ⅸ夜于 2009-9-26 12:05 编辑 ]

补答收到，但评分结果没有变化。-ldy

'论坛ID: 第Ⅸ夜 26的整倍数未通过验证(26*2=B@ ?) +1
Function N2Char26R(ByVal L As String) As Double
Dim i As Integer, j As Integer
L = UCase(L)
j = Len(L)
N2Char26R = 0
For i = 1 To j
N2Char26R = (Asc(Mid(L, i, 1)) - 64) * 26 ^ (j - i) + N2Char26R
Next
N2Char26R = N2Char26R
End Function
Function N2Char26(ByVal L As Double) As String
Dim i As Integer, j As Integer, M As Double
M = L
j = 1
N2Char26 = ""
Do While M / 26 > 1
M = M / 26
j = j + 1
Loop
If j = 1 Then
N2Char26 = Chr(L + 64)
Else
For i = j To 2 Step -1
K = Int(L / 26 ^ (i - 1))
N2Char26 = N2Char26 & Chr(64 + K)
L = L - 26 ^ (i - 1) * K
Next i
N2Char26 = N2Char26 & Chr(L + 64)
End If
End Function

复制代码

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

nyafullee · 发表于 2009-9-23 11:20

邮件已发送，请版主查收

收到，只做了题目1 -ldy

'论坛ID: nyafullee +1
Function N2Char26R(ByVal L As String) As Double
Dim i%, s$, s1$, n#
s = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
For i = 1 To Len(L)
n = InStr(1, s, Mid(L, i, 1), 1)
s1 = s1 & n & "*26" & Chr(94) & Len(L) - i & "+"
Next
s1 = s1 & "0"
N2Char26R = Application.Evaluate(s1) * 1
End Function

复制代码

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

jmouse · 发表于 2009-9-23 14:57

邮件已发送,请查阅.

收到 —ldy

'论坛ID: jmouse 26的整倍数未通过验证(26=A@ ?) +1 补答正确 +1
Function N2Char26R(ByVal L As String) As Double
'你的代码要求EXCEL2003下可运行
'要求不仅限于 2003的IV（256) 和 2007 的XFD（16384列）
'具体要求请运行验证1
L = UCase(L)
I = 1
While L <> ""
N2Char26R = (Asc(Right(L, 1)) - 64) * I + N2Char26R
L = Left(L, Len(L) - 1)
I = I * 26
Wend
End Function
Function N2Char26(ByVal L As Double) As String'第二次补答正确
'你的代码要求EXCEL2003下可运行
'具体要求请运行验证2
While L >= 26
m = L - Int((L / 26)) * 26
If m = 0 Then
N2Char26 = "Z" + N2Char26
L = Int((L / 26)) - 1
Else
N2Char26 = Chr(m + 64) + N2Char26
L = Int((L / 26))
End If
Wend
If L <> 0 Then N2Char26 = Chr(L + 64) + N2Char26
End Function
Function N2Char26(ByVal L As Double) As String'第一次答案 26的整倍数未通过验证(26=A@ ?) +1
'你的代码要求EXCEL2003下可运行
'具体要求请运行验证2
While L >= 26
m = L - Int((L / 26)) * 26
N2Char26 = Chr(m + 64) + N2Char26
L = Int((L / 26))
Wend
N2Char26 = Chr(L + 64) + N2Char26
End Function

复制代码

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

amulee · 发表于 2009-9-24 10:25

邮件已发，请楼主查收。

收到 -ldy

'论坛ID：amulee Ok +3
Function N2Char26R(ByVal L As String) As Double
'你的代码要求EXCEL2003下可运行
'要求不仅限于 2003的IV（256) 和 2007 的XFD（16384列）
'具体要求请运行验证1
Dim i&, StrTemp$
L = UCase(L)
For i = 0 To Len(L) - 1
StrTemp = Mid(L, Len(L) - i, 1)
N2Char26R = N2Char26R + (Asc(StrTemp) - 64) * 26 ^ i
Next i
End Function
Function N2Char26(ByVal L As Double) As String
'你的代码要求EXCEL2003下可运行
'具体要求请运行验证2
Dim iMod As Long, dInt As Double, sChar As String
'Application.Volatile
dInt = Int(L / 26)
iMod = L - dInt * 26
If iMod > 0 Then
sChar = Chr(64 + iMod)
ElseIf dInt > 0 Then
dInt = dInt - 1
sChar = "Z"
End If
Do While dInt > 0
iMod = dInt - Int(dInt / 26) * 26
dInt = Int(dInt / 26)
If iMod > 0 Then
sChar = Chr(64 + iMod) & sChar
ElseIf dInt > 0 Then
dInt = dInt - 1
sChar = "Z" & sChar
End If
Loop
N2Char26 = sChar
End Function

复制代码

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

jmouse · 发表于 2009-9-25 11:44

光顾着验证2了，没注意到那个。。不知道能不能重做的，已经重发答案（手一抖多发一封空信，见谅。。。）

linpansheng · 发表于 2009-9-25 13:41

中午看看。做第1小题先，捞1分也值得，其他有空再想。答案今晚发送，收下国庆礼包

收到，只做了题目 1 -ldy

'论坛ID: linpansheng 只做了题目1 正确 +1
Function N2Char26R(ByVal L As String) As Double
' 你的代码要求EXCEL2003下可运行
Dim i As Double
Dim B As Double
L = UCase(L)
For i = 1 To Len(L)
' B = B + 26 ^ (i - 1) * (Asc(Mid(L, Len(L) - i + 1, 1)) - 64) ' select case语句可以此代替--ldy
Select Case Mid(L, Len(L) - i + 1, 1)
Case "A": B = B + 26 ^ (i - 1) * 1
Case "B": B = B + 26 ^ (i - 1) * 2
Case "C": B = B + 26 ^ (i - 1) * 3
Case "D": B = B + 26 ^ (i - 1) * 4
Case "E": B = B + 26 ^ (i - 1) * 5
Case "F": B = B + 26 ^ (i - 1) * 6
Case "G": B = B + 26 ^ (i - 1) * 7
Case "H": B = B + 26 ^ (i - 1) * 8
Case "I": B = B + 26 ^ (i - 1) * 9
Case "J": B = B + 26 ^ (i - 1) * 10
Case "K": B = B + 26 ^ (i - 1) * 11
Case "L": B = B + 26 ^ (i - 1) * 12
Case "M": B = B + 26 ^ (i - 1) * 13
Case "N": B = B + 26 ^ (i - 1) * 14
Case "O": B = B + 26 ^ (i - 1) * 15
Case "P": B = B + 26 ^ (i - 1) * 16
Case "Q": B = B + 26 ^ (i - 1) * 17
Case "R": B = B + 26 ^ (i - 1) * 18
Case "S": B = B + 26 ^ (i - 1) * 19
Case "T": B = B + 26 ^ (i - 1) * 20
Case "U": B = B + 26 ^ (i - 1) * 21
Case "V": B = B + 26 ^ (i - 1) * 22
Case "W": B = B + 26 ^ (i - 1) * 23
Case "X": B = B + 26 ^ (i - 1) * 24
Case "Y": B = B + 26 ^ (i - 1) * 25
Case "Z": B = B + 26 ^ (i - 1) * 26
End Select
Next i
N2Char26R = B
End Function

复制代码

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

shuts32 · 发表于 2009-9-25 23:29

谢谢刘版送分，这次检大便宜了，，哇哈哈！！

kowloon · 发表于 2009-9-26 12:29

先占位, 晚上再发邮件

收到， -ldy

'论坛ID: kowloon 结果正确，速度未达标 +2
Function N2Char26R(ByVal L As String) As Double
L = UCase(L)
S = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
N2Char26R = 0
For i = Len(L) To 1 Step -1
j = InStr(S, Mid(L, i, 1))
If j = 0 Then
Error 0
Exit Function
Else
N2Char26R = N2Char26R + j * 26 ^ (Len(L) - i)
End If
Next
End Function
Function N2Char26(ByVal L As Double) As String
Dim ar(0 To 10, 1 To 2)
Dim a, a1, LL, LLL
For a = 0 To 10
ar(a, 1) = 26 ^ a
a1 = a1 + 26 ^ a
ar(a, 2) = a1 - 1
If L < a1 Then
L1 = a
Exit For
End If
Next
For i = L1 To 1 Step -1
LL = L - ar(i - 1, 2)
LLL = WorksheetFunction.RoundUp(LL / ar(i - 1, 1), 0)
N2Char26 = N2Char26 & Chr(64 + LLL)
L = L - ar(i - 1, 1) * LLL
Next
End Function

复制代码

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

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

[Excel 程序开发] [第53期]EXCEL26进制来回转换 ---------已结

本帖子中包含更多资源

评分

评分

评分

评分

评分

评分

评分

评分