在 vba 中使用字母代替数字作为计数器
Use alphabet as counter instead of number in vba
我想像变量 say 一样递增地附加一个字母表
我通过 JohnBox 那么它应该是 JohnBox_a 然后下一次它会是：
JohnBox_b
.
.
JohnBox_z
JohnBox_aa
.
.
JohnBox_zz
有人可以帮忙解决这个问题吗？到目前为止，这是我尝试过的方法，但 Case 2 是我遇到问题的地方：
Public Function fCalcNextID(strID As String) As Variant
Dim strName As String
'Extract Numeric Component
strName = Left(strID, InStr(strID, "_"))
If Len(Nz(strName, "")) = 0 Then
strName = strID
Else
strName = strName
End If
Select Case Len(Right(strID, (Len(strID) - (InStr(strID, "_")))))
Case 1 'single alpha (a)
If Right$(strID, 1) = "z" Then
fCalcNextID = strName & "aa"
Else
fCalcNextID = strName & Chr$(Asc(Right$(strID, 1)) + 1)
End If
Case 2 'double alpha (bd)
If Right$(strID, 1) = "z" Then
If Mid$(strID, 4, 1) = "z" Then
fCalcNextID = CStr(strName + 1) & "a"
Else
fCalcNextID = CStr(strName) & Chr$(Asc(Mid$(strID, 4)) + 1) & "a"
End If
Else '101bd, 102tx, etc.
'Increment last character, 101bd ==> 101be
fCalcNextID = Left$(strName, 4) & Chr$(Asc(Right$(strID, 1)) + 1)
End If
Case Else
fCalcNextID = strName & "_a"
End Select
End Function
你所拥有的本质上是一个 base26 计数。您可以使用模数函数而不是当前代码来实现它。您将不得不自己创建 VBA 代码，只为您提供算法：
例如：
用 a-z 创建数组
Input a value:
cde
Convert to numeric: 3*26*26+4*26+5
Add 1: 3*26*26+4*26+5+1
input=3*26*26+4*26+6
LOOP until input equals 0:
Mod(input,26) returns remnant (first loop:6, 2nd loop: 4, 3rd loop: 3) => look up in array => f (first loop) (2nd loop d, third loop c).
returnval=lookup value+returnval;
input=Divide (input - mod output (input))/26
END LOOP
您的问题的解决方案已经可以在此 LINK 中找到。 感谢 UtterAccess Wiki
link 提供了 2 个功能：Base10ToBaseLetter 和 BaseLetterToBase10。
下面显示了这些功能，以防 link 更改或变得不可用。
Public Function Base10ToBaseLetter(ByVal lngNumber As Long) As String
' Code courtesy of UtterAccess Wiki
' http://www.utteraccess.com/wiki/index.php/Category:FunctionLibrary
' Licensed under Creative Commons License
' http://creativecommons.org/licenses/by-sa/3.0/
'
' You are free to use this code in any application,
' provided this notice is left unchanged.
' ================================================================================
' Concept:
' Base10: Decimal 123 => (1 * 10 ^ 2) + (2 * 10 ^ 1) + (3 * 10 ^ 0)
' Base26: Decimal 123 => ( 4 * 26 ^ 1) + (19 * 26 ^ 0)
' Representing 4 and 19 with letters: "DS"
' MSD = Most Significant Digit
' LSD = Least Significant Digit
' ================================================================================
' Returns ZLS for input values less than 1
' Error handling not critical. Input limited to Long so should not normally fail.
' ================================================================================
Dim intBase26() As Integer 'Array of Base26 digits LSD (Index = 0) to MSD
Dim intMSD As Integer 'Most Significant Digit Index
Dim n As Integer 'Counter
If lngNumber > 0 Then
' Calculate MSD position (Integer part of Log to Base26 of lngNumber)
' Log of X to Base Y = Log(X) / Log(Y) for any Base used in calculation.
' (VBA Log function uses the Natural Number as the Base)
intMSD = Int(Log(lngNumber) / Log(26))
ReDim intBase26(0 To intMSD)
For n = intMSD To 0 Step -1
' Calculate value of nth digit in Base26
intBase26(n) = Int(lngNumber / 26 ^ n)
' Reduce lngNumber by value of nth digit
lngNumber = lngNumber - ((26 ^ n) * intBase26(n))
Next
' Base Letter doesn't have a zero equivalent.
' Rescale 0 to 26 (digital representation of "Z")
' and "borrow" by decrementing next higher MSD.
' Digit can be -1 from previous borrow onto an already zero digit
' Rescale to 25 (digital representation of "Y")
' Looping from LSD toward MSD
' MSD not processed because it cannot be zero and
' avoids potential out of range intBase26(n + 1)
For n = 0 To intMSD - 1
If intBase26(n) < 1 Then
intBase26(n) = 26 + intBase26(n) ' Rescale value
intBase26(n + 1) = intBase26(n + 1) - 1 ' Decrement next higher MSD
End If
Next
' Ignore MSD if reduced to zero by "borrow"
If intBase26(intMSD) = 0 Then intMSD = intMSD - 1
' Convert Base26 array to string
For n = intMSD To 0 Step -1
Base10ToBaseLetter = Base10ToBaseLetter & Chr((intBase26(n) + 64))
Next
End If
End Function
Public Function BaseLetterToBase10(ByVal strInput As String) As Long
' Upper or lower case characters accepted as input
' ZLS returns 0
' Negative return value indicates error:
' Unaceptable character or Overflow (string value exceeds "FXSHRXW")
' Digit indicates character position where error encountered
' MSD = Most Significant Digit
Dim intMSD As Integer 'MSD Position
Dim intChar As Integer 'Character Position in String
Dim intValue As Integer 'Value from single character
Dim n As Integer 'Counter
On Error GoTo ErrorHandler
' Convert String to UpperCase
strInput = UCase(strInput)
' Calculate Base26 magnitude of MSD
intMSD = Len(strInput) - 1
For n = intMSD To 0 Step -1
intChar = intMSD - n + 1
intValue = Asc(Mid(strInput, intChar, 1)) - 64
' Test for character A to Z
If intValue < 0 Or intValue > 26 Then
BaseLetterToBase10 = -intChar
Exit For
Else
' Add Base26 value to output
BaseLetterToBase10 = BaseLetterToBase10 + intValue * 26 ^ n
End If
Next
Exit Function
ErrorHandler:
BaseLetterToBase10 = -intChar: Exit Function
End Function
现在要将其应用到您的需要中，您只需调用这些函数：
Public Function fCalcNextID(strID As String) As String
Dim CurIdx As String, n As Integer, x As Long
On Error Resume Next
CurIdx = UCase(Split(strID, "_")(1))
On Error GoTo 0
If CurIdx <> "" Then
x = BaseLetterToBase10(CurIdx) + 1
fCalcNextID = Split(strID, "_")(0) & "_" & LCase(Base10ToBaseLetter(x))
Else
fCalcNextID = strID & "_a"
End If
End Function
这不是我。是他们。我所做的只是让 Google 帮我找到它。
尽管如此，希望这对您有所帮助，并且确实是您所需要的。
重要提示：不要删除评论。这是作者唯一的要求。
我想像变量 say 一样递增地附加一个字母表
我通过 JohnBox 那么它应该是 JohnBox_a 然后下一次它会是：
JohnBox_b
.
.
JohnBox_z
JohnBox_aa
.
.
JohnBox_zz
有人可以帮忙解决这个问题吗？到目前为止，这是我尝试过的方法，但 Case 2 是我遇到问题的地方：
Public Function fCalcNextID(strID As String) As Variant
Dim strName As String
'Extract Numeric Component
strName = Left(strID, InStr(strID, "_"))
If Len(Nz(strName, "")) = 0 Then
strName = strID
Else
strName = strName
End If
Select Case Len(Right(strID, (Len(strID) - (InStr(strID, "_")))))
Case 1 'single alpha (a)
If Right$(strID, 1) = "z" Then
fCalcNextID = strName & "aa"
Else
fCalcNextID = strName & Chr$(Asc(Right$(strID, 1)) + 1)
End If
Case 2 'double alpha (bd)
If Right$(strID, 1) = "z" Then
If Mid$(strID, 4, 1) = "z" Then
fCalcNextID = CStr(strName + 1) & "a"
Else
fCalcNextID = CStr(strName) & Chr$(Asc(Mid$(strID, 4)) + 1) & "a"
End If
Else '101bd, 102tx, etc.
'Increment last character, 101bd ==> 101be
fCalcNextID = Left$(strName, 4) & Chr$(Asc(Right$(strID, 1)) + 1)
End If
Case Else
fCalcNextID = strName & "_a"
End Select
End Function
你所拥有的本质上是一个 base26 计数。您可以使用模数函数而不是当前代码来实现它。您将不得不自己创建 VBA 代码，只为您提供算法：
例如：
用 a-z 创建数组
Input a value:
cde
Convert to numeric: 3*26*26+4*26+5
Add 1: 3*26*26+4*26+5+1
input=3*26*26+4*26+6
LOOP until input equals 0:
Mod(input,26) returns remnant (first loop:6, 2nd loop: 4, 3rd loop: 3) => look up in array => f (first loop) (2nd loop d, third loop c).
returnval=lookup value+returnval;
input=Divide (input - mod output (input))/26
END LOOP
您的问题的解决方案已经可以在此 LINK 中找到。 感谢 UtterAccess Wiki
link 提供了 2 个功能：Base10ToBaseLetter 和 BaseLetterToBase10。
下面显示了这些功能，以防 link 更改或变得不可用。
Public Function Base10ToBaseLetter(ByVal lngNumber As Long) As String
' Code courtesy of UtterAccess Wiki
' http://www.utteraccess.com/wiki/index.php/Category:FunctionLibrary
' Licensed under Creative Commons License
' http://creativecommons.org/licenses/by-sa/3.0/
'
' You are free to use this code in any application,
' provided this notice is left unchanged.
' ================================================================================
' Concept:
' Base10: Decimal 123 => (1 * 10 ^ 2) + (2 * 10 ^ 1) + (3 * 10 ^ 0)
' Base26: Decimal 123 => ( 4 * 26 ^ 1) + (19 * 26 ^ 0)
' Representing 4 and 19 with letters: "DS"
' MSD = Most Significant Digit
' LSD = Least Significant Digit
' ================================================================================
' Returns ZLS for input values less than 1
' Error handling not critical. Input limited to Long so should not normally fail.
' ================================================================================
Dim intBase26() As Integer 'Array of Base26 digits LSD (Index = 0) to MSD
Dim intMSD As Integer 'Most Significant Digit Index
Dim n As Integer 'Counter
If lngNumber > 0 Then
' Calculate MSD position (Integer part of Log to Base26 of lngNumber)
' Log of X to Base Y = Log(X) / Log(Y) for any Base used in calculation.
' (VBA Log function uses the Natural Number as the Base)
intMSD = Int(Log(lngNumber) / Log(26))
ReDim intBase26(0 To intMSD)
For n = intMSD To 0 Step -1
' Calculate value of nth digit in Base26
intBase26(n) = Int(lngNumber / 26 ^ n)
' Reduce lngNumber by value of nth digit
lngNumber = lngNumber - ((26 ^ n) * intBase26(n))
Next
' Base Letter doesn't have a zero equivalent.
' Rescale 0 to 26 (digital representation of "Z")
' and "borrow" by decrementing next higher MSD.
' Digit can be -1 from previous borrow onto an already zero digit
' Rescale to 25 (digital representation of "Y")
' Looping from LSD toward MSD
' MSD not processed because it cannot be zero and
' avoids potential out of range intBase26(n + 1)
For n = 0 To intMSD - 1
If intBase26(n) < 1 Then
intBase26(n) = 26 + intBase26(n) ' Rescale value
intBase26(n + 1) = intBase26(n + 1) - 1 ' Decrement next higher MSD
End If
Next
' Ignore MSD if reduced to zero by "borrow"
If intBase26(intMSD) = 0 Then intMSD = intMSD - 1
' Convert Base26 array to string
For n = intMSD To 0 Step -1
Base10ToBaseLetter = Base10ToBaseLetter & Chr((intBase26(n) + 64))
Next
End If
End Function
Public Function BaseLetterToBase10(ByVal strInput As String) As Long
' Upper or lower case characters accepted as input
' ZLS returns 0
' Negative return value indicates error:
' Unaceptable character or Overflow (string value exceeds "FXSHRXW")
' Digit indicates character position where error encountered
' MSD = Most Significant Digit
Dim intMSD As Integer 'MSD Position
Dim intChar As Integer 'Character Position in String
Dim intValue As Integer 'Value from single character
Dim n As Integer 'Counter
On Error GoTo ErrorHandler
' Convert String to UpperCase
strInput = UCase(strInput)
' Calculate Base26 magnitude of MSD
intMSD = Len(strInput) - 1
For n = intMSD To 0 Step -1
intChar = intMSD - n + 1
intValue = Asc(Mid(strInput, intChar, 1)) - 64
' Test for character A to Z
If intValue < 0 Or intValue > 26 Then
BaseLetterToBase10 = -intChar
Exit For
Else
' Add Base26 value to output
BaseLetterToBase10 = BaseLetterToBase10 + intValue * 26 ^ n
End If
Next
Exit Function
ErrorHandler:
BaseLetterToBase10 = -intChar: Exit Function
End Function
现在要将其应用到您的需要中，您只需调用这些函数：
Public Function fCalcNextID(strID As String) As String
Dim CurIdx As String, n As Integer, x As Long
On Error Resume Next
CurIdx = UCase(Split(strID, "_")(1))
On Error GoTo 0
If CurIdx <> "" Then
x = BaseLetterToBase10(CurIdx) + 1
fCalcNextID = Split(strID, "_")(0) & "_" & LCase(Base10ToBaseLetter(x))
Else
fCalcNextID = strID & "_a"
End If
End Function
这不是我。是他们。我所做的只是让 Google 帮我找到它。
尽管如此，希望这对您有所帮助，并且确实是您所需要的。
重要提示：不要删除评论。这是作者唯一的要求。