在vba中使用字母作为计数器而不是数字

时间:2015-03-16 02:54:56

标签: vba access-vba

我想逐渐添加一个字母,就像变量一样 我通过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

2 个答案:

答案 0 :(得分:1)

你所拥有的基本上是一个基数26。您可以使用模数函数而不是当前代码来实现它。您必须自己创建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

答案 1 :(得分:1)

您的问题的解决方案已在此LINK中找到。 对UtterAccess Wiki的信用
该链接提供了2个功能:Base10ToBaseLetterBaseLetterToBase10。左侧功能如下所示,以防链接发生变化或变得不可用。

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为我找到它 尽管如此,希望这会有所帮助,实际上是你所需要的 重要提示:请勿删除评论。这是作者的唯一要求。