【问题标题】:Use alphabet as counter instead of number in vba在 vba 中使用字母作为计数器而不是数字
【发布时间】:2020-07-13 21:00:51
【问题描述】:

我想像变量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

【问题讨论】:

    标签: ms-access vba


    【解决方案1】:

    您的问题的解决方案已在此LINK 中找到。 感谢 UtterAccess Wiki
    该链接提供了两个功能: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 为我找到它。
    尽管如此,希望这会有所帮助,并且确实是您所需要的。
    重要提示:不要删除 cmets。这是作者唯一的要求。

    【讨论】:

    • 非常感谢您在这个问题上为我提供指导。非常感谢
    • 刚刚检查了您提供的 wiki 链接,遗憾的是它似乎不再存在,很好的答案。
    • @KySoto 一定是搬家了,好东西在这里复制了一份。
    【解决方案2】:

    您所拥有的本质上是一个 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
    

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 2022-12-18
      • 2019-12-01
      • 2018-01-02
      • 2015-11-12
      • 1970-01-01
      • 1970-01-01
      • 2017-07-17
      • 1970-01-01
      相关资源
      最近更新 更多