VBA EXCEL：模式创建功能用字符替换数字

Question

我写了下面提到的代码，但它不起作用。有人可以帮忙吗？

说明： 设置7位或8位数字。如果数字是8位数，则删除前2个数字，如果数字是7位数，则删除第一个数字。留下一个6位数字，从而可以重复每个数字而不受任何限制。因此，可以在000001和999999之间设置一个数字。（左边的零点数）。

代码在前3位数字上起作用，但稍后虽然我使用相同的逻辑但是无法正常工作。代码的功能是通过将数字转换为字符来生成所有可能的模式。

约束：

• 使用的字母仅为a，b，c，d，e和f。
• 字符应按系统顺序运行

根据这个逻辑：

• 模式可以介于aaaaaa和abcdef之间。
• 第一个字符始终为“a”，如果所有数字彼此不同，则最后一个字符可以为“f”。

因此，数字454657被翻译为abacbd或123456被翻译为abcdef。 （c如果没有b则不存在，如果没有b和c则不能存在。）

 Private Sub CommandButton1_Click()
        Dim GSM_Counter, GSM, GSM_Range, a, b, c, d, e, f As String
        Dim GSM_length, Num1, Num2, Num3, Num4, Num5, Num6, a1, b1, c1, d1, e1, f1 As integer
        GSM_Counter = Application.WorksheetFunction.CountA(Range("A:A"))
For i = 2 To GSM_Counter
        GSM_length = Len(Range("A" & i))
            Select Case GSM_length
                Case Is = 8
                    Range("B" & i) = Left(Range("A" & i), 2)
                    Num1 = Right(Left(Range("A" & i), 3), 1)
                    Num2 = Right(Left(Range("A" & i), 4), 1)
                    Num3 = Right(Left(Range("A" & i), 5), 1)
                    Num4 = Right(Left(Range("A" & i), 6), 1)
                    Num5 = Right(Left(Range("A" & i), 7), 1)
                    Num6 = Right(Left(Range("A" & i), 8), 1)
            Case Is = 7
                Range("B" & i) = Left(Range("A" & i), 1)
                Num1 = Right(Left(Range("A" & i), 2), 1)
                Num2 = Right(Left(Range("A" & i), 3), 1)
                Num3 = Right(Left(Range("A" & i), 4), 1)
                Num4 = Right(Left(Range("A" & i), 5), 1)
                Num5 = Right(Left(Range("A" & i), 6), 1)
                Num6 = Right(Left(Range("A" & i), 7), 1)
            End Select
                Range("C" & i) = Num1
                Range("D" & i) = Num2
                Range("E" & i) = Num3
                Range("F" & i) = Num4
                Range("G" & i) = Num5
                Range("H" & i) = Num6
Next i

For k = 2 To GSM_Counter
                a1 = Range("C" & k)
                b1 = Range("D" & k)
                c1 = Range("E" & k)
                d1 = Range("F" & k)
                e1 = Range("G" & k)
                f1 = Range("H" & k)
                a = "a"
                Range("K" & k) = a
                If b1 = a1 Then
                    b = "a"
                    Else
                    b = "b"
                End If
                Range("L" & k) = b
                If c1 = a1 Then
                    c = "a"
                    ElseIf c1 = b1 Then
                    c = "b"
                    Else
                    c = "c"
                End If
                Range("M" & k) = c
                If d1 = a1 Then
                    d = "a"
                    ElseIf d1 = b1 Then
                    d = "b"
                    ElseIf d1 = c1 Then
                    d = "c"
                    Else
                    d = "d"
                End If
                Range("N" & k) = d
                If e1 = a1 Then
                    e = "a"
                    ElseIf e1 = b1 Then
                    e = "b"
                    ElseIf e1 = c1 Then
                    e = "c"
                    ElseIf e1 = d1 Then
                    e = "d"
                    Else
                    e = "e"
                End If
                Range("O" & k) = e
                If f1 = a1 Then
                    f = "a"
                    ElseIf f1 = b1 Then
                    f = "b"
                    ElseIf f1 = c1 Then
                    f = "c"
                    ElseIf f1 = d1 Then
                    f = "d"
                    ElseIf f1 = e1 Then
                    f = "e"
                    Else
                    f = "f"
                End If
                Range("P" & k) = f
                Next k
End Sub

Answer 1

这是另一种方式..

'~~> Test Data
Sub Sample()
    Dim TestArray(1 To 6) As Long
    Dim i As Long

    TestArray(1) = 468013: TestArray(2) = 12234455: TestArray(3) = 234523
    TestArray(4) = 44444444: TestArray(5) = 123: TestArray(6) = 111222

    For i = 1 To 6
        Debug.Print TestArray(i) & " --> " & Encrypt(TestArray(i))
    Next i
End Sub

'~~> Actual Function
Function Encrypt(n As Long) As String
    Dim j As Long, k As Long, sNum As String

    sNum = Format(CLng(Right(n, 6)), "000000")

    j = 97

    For k = 1 To 6
        If IsNumeric(Mid(sNum, k, 1)) Then
            sNum = Replace(sNum, Mid(sNum, k, 1), Chr(j))
            j = j + 1
        End If
    Next k
    Encrypt = sNum
End Function

输出

468013 --> abcdef
12234455 --> abccdd
234523 --> abcdab
44444444 --> aaaaaa
123 --> aaabcd
111222 --> aaabbb

修改：

如果您打算将它用作工作表函数，并且您不确定那里会有什么样的输入，那么请更改

Function Encrypt(n As Long) As String

到

Function Encrypt(n As Variant) As String

Answer 2

我建议您了解Chr()和Asc() VBA函数以及数字和字母字符如何转换为ASCII代码字符的一般知识。我可能会读错了，但我认为我看到了示例，您的描述和提供的实际代码之间的一些矛盾。这是将模式生成放入用户定义函数或 UDF 的一种方法。

Function num_2_alpha(sNUM As String)
    'ASCII 0-9 = 46-57, a-z = 97-122
    Dim tmp As String, i As Long, c As Long
    sNUM = Right(sNUM, 6)
    tmp = Chr(97) ' =a
    For i = 2 To 6
        If CBool(InStr(1, Left(sNUM, i - 1), Mid(sNUM, i, 1))) Then
            tmp = tmp & Mid(tmp, InStr(1, Left(sNUM, i - 1), Mid(sNUM, i, 1)), 1)
        Else
            'tmp = tmp & Chr(i + 96)
            c = c + 1
            tmp = tmp & Chr(c + 97)   'alternate (code) method
        End If
    Next i
    num_2_alpha = tmp
End Function

请注意，我提供了另一种注释掉的方法。该行或其上方的行应该是活动的;从来没有一次。这些是产生的结果。

附录：我相信我最近的编辑应该有助于符合您在评论中留下的示例。代码和图片已更新。