求一个34进制转换10进制 不要i和o

lsdongjh

刚才没注意 不要I和O

1. Sub Test()
   
2.     Dim arr As Variant, lngRow As Long
   
3.     Dim strTemp As String, strHead As String, strMiddle As String, strLast As String
   
4.         
   
5.     arr = Sheet1.Range("A1:C2")
   
6.     For lngRow = LBound(arr) To UBound(arr)
   
7.         strTemp = arr(lngRow, 1)
   
8.         strTemp = UCase(strTemp)
   
9.         strTemp = Trim(strTemp)
   
10.         strHead = Mid(strTemp, 1, 6)
    
11.         strMiddle = Mid(strTemp, 7, Len(strTemp) - 8)
    
12.         strLast = Right(strTemp, 2)
    
13.         
    
14.         arr(lngRow, 2) = strHead & Return34To10String(strMiddle)
    
15.         arr(lngRow, 3) = Return34To10String(strLast)
    
16.     Next
    
17.    
    
18.     Sheet1.Range("A1:C2") = arr
    
19. End Sub
    
20. 
    
21. 
    
22. 
    
23. Function Return34To10String(strVal As String) As String
    
24.     Dim strTemp As String
    
25.     Dim intID As Integer, intLen As Integer
    
26.     Dim lngAsc As Long, lngResult As Long, strResult As String
    
27.    
    
28.     strVal = Trim(strVal)
    
29.     strVal = UCase(strVal)
    
30.     intLen = Len(strVal)
    
31.    
    
32.     For intID = 1 To intLen
    
33.         strTemp = Mid(strVal, intID, 1)
    
34.         lngAsc = Asc(strTemp)
    
35.         Select Case lngAsc
    
36.             Case 48 To 57
    
37.                 lngResult = (lngAsc - 48) * (34 ^ (intLen - intID))
    
38.             Case 65 To 72
    
39.                 lngResult = (lngAsc - 55) * (34 ^ (intLen - intID))
    
40.             Case 74 To 78
    
41.                 lngResult = (lngAsc - 56) * (34 ^ (intLen - intID))
    
42.             Case 80 To 90
    
43.                 lngResult = (lngAsc - 57) * (34 ^ (intLen - intID))
    
44.         End Select
    
45.         strResult = Val(strResult) + lngResult
    
46.     Next
    
47.     Return34To10String = strResult
    
48. End Function
    

复制代码

香川群子

要转换的34进制的位数事先不确定吗？

YZC51

喜你不及 发表于 2019-1-21 15:19
我更新了下附件 具体看5楼的 我想用后台代码实现

请参考
http://club.excelhome.net/thread-1428547-1-1.html

喜你不及

香川群子 发表于 2019-1-21 17:05
要转换的34进制的位数事先不确定吗？

详细看一楼 我之前没写好 抱歉，

一把小刀闯天下

Option Explicit

Sub test()
  Dim s, mark
  mark = Split("0 1 2 3 4 5 6 7 8 9 A B C D E F G H J K L M N P Q R S T U W V X T Z")
  s = "1"
  Debug.Print s, C34_to_10(s, mark)
  s = "10"
  Debug.Print s, C34_to_10(s, mark)
  s = "21"
  Debug.Print s, C34_to_10(s, mark)
End Sub

Function C34_to_10(s, mark) As Long
    Dim i, j, n As Long, t As String
    s = UCase(s)
    For i = 1 To Len(s)
      t = Mid(s, Len(s) - i + 1, 1)
      For j = 0 To UBound(mark)
        If mark(j) = t Then
          n = n + 34 ^ (i - 1) * j
          Exit For
        End If
      Next
    Next
    C34_to_10 = n
End Function

香川群子

这是一个特殊而具体的要求。

用Change事件处理吧。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Column > 1 Then Exit Sub
    s = Target.Value
    If Len(s) = 10 Then
        Target.Offset(, 1) = "M" & Left(s, 6) & f(Mid(s, 7, 2))
        Target.Offset(, 2) = f(Right(s, 2))
    End If
End Sub

特定的自定义函数
Function f$(s$)
    f = Right("00" & ((InStr("0123456789ABCDEFGHJKLMNPQRSTUVWXYZ", Left(s, 1)) - 1) * 34 + InStr("0123456789ABCDEFGHJKLMNPQRSTUVWXYZ", Right(s, 1)) - 1), 3)
End Function

喜你不及

香川群子 发表于 2019-1-22 15:19
这是一个特殊而具体的要求。

用Change事件处理吧。

谢谢你的帮助，这个事件好像是输入一个才加载一个 如果我复制粘贴批量 那么这个事件就不反应了。。。

香川群子

喜你不及 发表于 2019-1-22 16:13
谢谢你的帮助，这个事件好像是输入一个才加载一个 如果我复制粘贴批量 那么这个事件就不反应了。。。

如果是批量处理，那么有2种情况：
1. 每次都是A列第2行开始，粘贴新数据，要求转换。
2. 每次都只是在A列最后一行增加新数据，只需要转换新数据。

这两种的处理方法，是不一样的。

…………
以及，我已经在模块中写入了自定义函数f(),你可以:
在B列写入公式：="M"&Left(A2,6)&f(Mid(A2,7,2))
在C列写入公式：=f(Right(A2,2))
公式下拉就可以了。