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

biaotiger1

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


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


收到  ——ldy

1. 
   
2. '论坛ID：biaotiger1  ok +3
   
3. 'Option Explicit
   
4. Function N2Char26R(ByVal L As String) As Double
   
5. '你的代码 要求EXCEL2003下可运行
   
6. '要求不仅限于 2003的IV（256) 和 2007 的XFD（16384列）
   
7. '具体要求请运行 验证1
   
8. Dim N As Double, K As Byte, I As Byte, C As Integer
   
9. C = Len(L)
   
10. For I = 1 To C
    
11.     K = Asc(UCase(Mid(L, I, 1))) - 64
    
12.     N = N + K * 26 ^ (C - I)
    
13. Next
    
14. N2Char26R = N
    
15. End Function
    
16. Function N2Char26(ByVal L As Double) As String
    
17. '你的代码 要求EXCEL2003下可运行
    
18. '具体要求请运行 验证2
    
19. Dim iMod As Integer, sChar As String, K As Integer, X As Integer
    
20. Dim Temp As Double, M As Double
    
21. iMod = Int(WorksheetFunction.Log(L, 26))
    
22. For X = iMod To 0 Step -1
    
23.     K = Int(L / 26 ^ X)
    
24.     Temp = K * 26 ^ X
    
25.     For M = 0 To X - 1
    
26.         Temp = Temp + 26 ^ M
    
27.     Next M
    
28.     If Temp > L Then
    
29.             K = IIf(Int(L / 26 ^ X) = 1, 0, K - 1)
    
30.     End If
    
31.     L = L - K * 26 ^ X
    
32.     sChar = sChar & Chr(K + 64)
    
33. Next
    
34. sChar = IIf(Left(sChar, 1) = "@", Right(sChar, Len(sChar) - 1), sChar)
    
35. N2Char26 = sChar
    
36. End Function
    

复制代码

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

lipton

信已发，请版主查收。



收到  ——ldy

1. 
   
2. '论坛ID lipton 26的整倍数未通过验证(26=AD  ?) +1 补票 +1
   
3. Function N2Char26R(ByVal L As String) As Double
   
4.     Dim iMod As Integer, dInt As Double
   
5.     Dim i As Byte
   
6.     Dim d1 As Double, d2 As Double
   
7.     Dim s1 As String
   
8.     iMod = Len(L)
   
9.     dInt = 0
   
10.     d2 = iMod - 1
    
11.     For i = 1 To iMod
    
12.         s1 = StrConv(Mid(L, i, 1), 1)
    
13.         d1 = Asc(s1) - 64
    
14.         dInt = dInt + d1 * (26 ^ d2)
    
15.         d2 = d2 - 1
    
16.     Next
    
17.     N2Char26R = dInt
    
18. End Function
    
19. Function N2Char26(L As Double) As String' 第二次答案正确
    
20. Dim iMod As Double, dInt As Double, sChar As String
    
21. Dim dblA As Double
    
22.         dInt = L
    
23.        If dInt = 0 Then
    
24.             N2Char26 = ""
    
25.             Exit Function
    
26.         End If
    
27.         
    
28.         Do
    
29.             iMod = dInt - Fix(dInt / 26) * 26
    
30.             dInt = Fix(1 / 26 * dInt)
    
31.             If iMod > 0 Then
    
32.                 sChar = Chr(iMod + 64) & sChar
    
33.             ElseIf dInt > 0 Then
    
34.                 dInt = dInt - 1
    
35.                 sChar = "Z" & sChar
    
36.             End If
    
37.         Loop While dInt > 0
    
38.     N2Char26 = sChar
    
39. End Function
    
40. 
    
41. Function N2Char26(L As Double) As String' 第一次答案 26的整倍数未通过验证(26=AD  ?) +1
    
42. Dim iMod As Double, dInt As Double, sChar As String
    
43. Dim dblA As Double
    
44.         iMod = (((L / 10) Mod 26) * 10) Mod 26
    
45.         dInt = Fix(1 / 26 * L)
    
46.         If iMod > 0 Then
    
47.             sChar = Chr(iMod + 64)
    
48.         ElseIf dInt > 0 Then
    
49.             dInt = dInt - 1
    
50.             sChar = "Z"
    
51.         End If
    
52.         Do While dInt > 0
    
53.             iMod = dInt Mod 26
    
54.             dInt = Fix(1 / 26 * dInt)
    
55.             If iMod > 0 Then
    
56.                 sChar = Chr(iMod + 64) & sChar
    
57.             ElseIf dInt > 0 Then
    
58.                 dInt = dInt - 1
    
59.                 sChar = "Z" & sChar
    
60.             End If
    
61.         Loop
    
62.     N2Char26 = sChar
    
63. End Function
    

复制代码

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

第Ⅸ夜

已经重新发送！

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


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

1. 
   
2. '论坛ID: 第Ⅸ夜 26的整倍数未通过验证(26*2=B@  ?) +1
   
3. Function N2Char26R(ByVal L As String) As Double
   
4.     Dim i As Integer, j As Integer
   
5.     L = UCase(L)
   
6.     j = Len(L)
   
7.     N2Char26R = 0
   
8.     For i = 1 To j
   
9.         N2Char26R = (Asc(Mid(L, i, 1)) - 64) * 26 ^ (j - i) + N2Char26R
   
10.     Next
    
11.     N2Char26R = N2Char26R
    
12. End Function
    
13. Function N2Char26(ByVal L As Double) As String
    
14.     Dim i As Integer, j As Integer, M As Double
    
15.     M = L
    
16.     j = 1
    
17.     N2Char26 = ""
    
18.     Do While M / 26 > 1
    
19.         M = M / 26
    
20.         j = j + 1
    
21.     Loop
    
22.     If j = 1 Then
    
23.         N2Char26 = Chr(L + 64)
    
24.     Else
    
25.         For i = j To 2 Step -1
    
26.             K = Int(L / 26 ^ (i - 1))
    
27.             N2Char26 = N2Char26 & Chr(64 + K)
    
28.             L = L - 26 ^ (i - 1) * K
    
29.         Next i
    
30.         N2Char26 = N2Char26 & Chr(L + 64)
    
31.     End If
    
32. End Function
    

复制代码

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

nyafullee

邮件已发送，请版主查收


收到，只做了题目1 -ldy

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

复制代码

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

jmouse

邮件已发送,请查阅.


收到 —ldy

1. 
   
2. '论坛ID: jmouse  26的整倍数未通过验证(26=A@  ?) +1 补答 正确 +1
   
3. Function N2Char26R(ByVal L As String) As Double
   
4. '你的代码 要求EXCEL2003下可运行
   
5. '要求不仅限于 2003的IV（256) 和 2007 的XFD（16384列）
   
6. '具体要求请运行 验证1
   
7.     L = UCase(L)
   
8.     I = 1
   
9.     While L <> ""
   
10.         N2Char26R = (Asc(Right(L, 1)) - 64) * I + N2Char26R
    
11.         L = Left(L, Len(L) - 1)
    
12.         I = I * 26
    
13.     Wend
    
14. End Function
    
15. 
    
16. Function N2Char26(ByVal L As Double) As String'第二次补答 正确
    
17. '你的代码 要求EXCEL2003下可运行
    
18. '具体要求请运行 验证2
    
19.     While L >= 26
    
20.         m = L - Int((L / 26)) * 26
    
21.         If m = 0 Then
    
22.             N2Char26 = "Z" + N2Char26
    
23.             L = Int((L / 26)) - 1
    
24.         Else
    
25.             N2Char26 = Chr(m + 64) + N2Char26
    
26.             L = Int((L / 26))
    
27.         End If
    
28.     Wend
    
29.     If L <> 0 Then N2Char26 = Chr(L + 64) + N2Char26
    
30. End Function
    
31. Function N2Char26(ByVal L As Double) As String'第一次答案 26的整倍数未通过验证(26=A@  ?) +1
    
32. '你的代码 要求EXCEL2003下可运行
    
33. '具体要求请运行 验证2
    
34.     While L >= 26
    
35.         m = L - Int((L / 26)) * 26
    
36.         N2Char26 = Chr(m + 64) + N2Char26
    
37.         L = Int((L / 26))
    
38.     Wend
    
39.     N2Char26 = Chr(L + 64) + N2Char26
    
40. End Function
    

复制代码

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

amulee

邮件已发，请楼主查收。


收到 -ldy

1. 
   
2. '论坛ID：amulee  Ok +3
   
3. Function N2Char26R(ByVal L As String) As Double
   
4. '你的代码 要求EXCEL2003下可运行
   
5. '要求不仅限于 2003的IV（256) 和 2007 的XFD（16384列）
   
6. '具体要求请运行 验证1
   
7.     Dim i&, StrTemp$
   
8.     L = UCase(L)
   
9.     For i = 0 To Len(L) - 1
   
10.         StrTemp = Mid(L, Len(L) - i, 1)
    
11.         N2Char26R = N2Char26R + (Asc(StrTemp) - 64) * 26 ^ i
    
12.     Next i
    
13. End Function
    
14. Function N2Char26(ByVal L As Double) As String
    
15. '你的代码 要求EXCEL2003下可运行
    
16. '具体要求请运行 验证2
    
17.     Dim iMod As Long, dInt As Double, sChar As String
    
18.     'Application.Volatile
    
19.     dInt = Int(L / 26)
    
20.     iMod = L - dInt * 26
    
21.     If iMod > 0 Then
    
22.         sChar = Chr(64 + iMod)
    
23.     ElseIf dInt > 0 Then
    
24.         dInt = dInt - 1
    
25.         sChar = "Z"
    
26.     End If
    
27.     Do While dInt > 0
    
28.         iMod = dInt - Int(dInt / 26) * 26
    
29.         dInt = Int(dInt / 26)
    
30.         If iMod > 0 Then
    
31.             sChar = Chr(64 + iMod) & sChar
    
32.         ElseIf dInt > 0 Then
    
33.             dInt = dInt - 1
    
34.             sChar = "Z" & sChar
    
35.         End If
    
36.     Loop
    
37.     N2Char26 = sChar
    
38. End Function
    

复制代码

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

jmouse

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

linpansheng

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


收到，只做了题目 1 -ldy

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

复制代码

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

shuts32

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

kowloon

先占位, 晚上再发邮件


收到， -ldy

1. 
   
2. '论坛ID: kowloon  结果正确，速度未达标 +2
   
3. Function N2Char26R(ByVal L As String) As Double
   
4.     L = UCase(L)
   
5.     S = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   
6.     N2Char26R = 0
   
7.     For i = Len(L) To 1 Step -1
   
8.         j = InStr(S, Mid(L, i, 1))
   
9.         If j = 0 Then
   
10.             Error 0
    
11.             Exit Function
    
12.         Else
    
13.             N2Char26R = N2Char26R + j * 26 ^ (Len(L) - i)
    
14.         End If
    
15.     Next
    
16. End Function
    
17. Function N2Char26(ByVal L As Double) As String
    
18.     Dim ar(0 To 10, 1 To 2)
    
19.     Dim a, a1, LL, LLL
    
20.     For a = 0 To 10
    
21.         ar(a, 1) = 26 ^ a
    
22.         a1 = a1 + 26 ^ a
    
23.         ar(a, 2) = a1 - 1
    
24.         If L < a1 Then
    
25.             L1 = a
    
26.             Exit For
    
27.         End If
    
28.     Next
    
29.     For i = L1 To 1 Step -1
    
30.         LL = L - ar(i - 1, 2)
    
31.         LLL = WorksheetFunction.RoundUp(LL / ar(i - 1, 1), 0)
    
32.         N2Char26 = N2Char26 & Chr(64 + LLL)
    
33.         L = L - ar(i - 1, 1) * LLL
    
34.     Next
    
35. End Function
    

复制代码

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