Arrays 使用VBA从字母表第n个位置查找单词链可能性的算法

我在网上遇到一个问题如下：

11216812520是字母表，183624911413是字母表____________

第一个数字就是字母表中每个字母的数字

1.12.16.8.1.2.5.20=A.L.p.H.A.B.E.T

当试图求解另一个数字时，虽然不是太难，但也有可能是1=A或11=K，以此类推

我想用VBA编写一个算法，可以列出所有可能的单词组合

我的代码：

Sub routine()

Dim num As String
Dim word As String
Dim arr() As String
Dim c As Collection

Set c = New Collection
c.Add "A", "1"
c.Add "B", "2"
c.Add "C", "3"
c.Add "D", "4"
c.Add "E", "5"
c.Add "F", "6"
c.Add "G", "7"
c.Add "H", "8"
c.Add "I", "9"
c.Add "J", "10"
c.Add "K", "11"
c.Add "L", "12"
c.Add "M", "13"
c.Add "N", "14"
c.Add "O", "15"
c.Add "P", "16"
c.Add "Q", "17"
c.Add "R", "18"
c.Add "S", "19"
c.Add "T", "20"
c.Add "U", "21"
c.Add "V", "22"
c.Add "W", "23"
c.Add "X", "24"
c.Add "Y", "25"
c.Add "Z", "26"

word = ""
num = Cells(1, 5).Value
j = 1

For i = 1 To Len(num)

        If Mid(num, i + 1, 1) = 0 Then

            arr(j) = Mid(num, i, 1) & Mid(num, i + 1, 1)
            j = j + 1

        ElseIf Mid(num, i + 1, 1) <= 6 And Mid(num, i, 1) <= 2 Then

            arr(j) = Mid(num, i, 1)
            arr(j + 1) = arr(j) & Mid(num, i + 1, 1)
            j = j + 1

        Else

            arr(j) = Mid(num, i + 1, 1)

        End If

Next i

Cells(1, 6).Value = word

End Sub

我收集了所有字母及其在字母表中的第n个位置。我正努力弄清楚这些词是如何产生的

如果我们看看上面[183624911413]中的第二个数字串，算法可以看到1和18分别是字母A和R， 然后，一个新的循环将以a的第二个字符开始，并看到它是8，因此将是H，因为83太大，而R的第三个字符，即C，因为36太大

随着这一过程的进行，算法必须查看当前字符串，即AH，并计算出其第n位1,8，看到字符串的长度为2，然后从原始数字中的第3位重新开始[3]

如果没有一大堆If语句，我想不出一个很好的方法来实现这一点，而这些If语句对于不确定长度的数字来说是不好的。

简单的答案是递归

我假设c是一个您不想保留的全局集合 每次递归时定义它。 输入是字符串，输出是字符串。 字符串中的数字只是符号，而不是数字。 任何递归行的端点都是空字符串这很容易 查证 我先去贪婪，因为任何一个数字都是有效的 性格 伪代码：

Function ConvertToCharacter(inputString, existingAnswer)
    IF inputString is empty THEN 
        output existingAnswer
        END recursion line
    IF length inputString > 2 THEN
        IF first2char are valid char then ConvertToCharacter(inputString less first two char, existingAnswer plus valid char)
    ConvertToCharacter(inputString less first char, existingAnswer plus other valid char)

每个递归调用可以分支为两个调用。但是，如果其中一个调用产生一个无意义的数字对，例如83，它将自动失败，因此不会产生结果

---

这种方法将为单个字符串提供多个答案。

这里的解决方案是C语言，它运行递归，当组合数字为时，我已经设法解决了这个问题，多亏@AJD发布了伪代码。我已经包括了下面的代码，它将根据一个数字列出所有可能的字母组合

Public iRow As Integer

Function ConvertToCharacter(inputString, existingAnswer)
    Dim c As Collection

    Set c = New Collection
    c.Add "A", "1"
    c.Add "B", "2"
    c.Add "C", "3"
    c.Add "D", "4"
    c.Add "E", "5"
    c.Add "F", "6"
    c.Add "G", "7"
    c.Add "H", "8"
    c.Add "I", "9"
    c.Add "J", "10"
    c.Add "K", "11"
    c.Add "L", "12"
    c.Add "M", "13"
    c.Add "N", "14"
    c.Add "O", "15"
    c.Add "P", "16"
    c.Add "Q", "17"
    c.Add "R", "18"
    c.Add "S", "19"
    c.Add "T", "20"
    c.Add "U", "21"
    c.Add "V", "22"
    c.Add "W", "23"
    c.Add "X", "24"
    c.Add "Y", "25"
    c.Add "Z", "26"
    c.Add " ", "27"

    If inputString = "" Then
        Cells(iRow, 1).Value = existingAnswer
        iRow = iRow + 1
        Exit Function
    ElseIf Len(inputString) >= 2 Then
        If Int(Left(inputString, 2)) <= 27 And Int(Left(inputString, 1)) <> "0" Then Call ConvertToCharacter(Right(inputString, Len(inputString) - 2), existingAnswer & c.Item(Left(inputString, 2)))
    End If
    If inputString <> "0" And Left(inputString, 1) <> "0" Then
        Call ConvertToCharacter(Right(inputString, Len(inputString) - 1), existingAnswer & c.Item(Left(inputString, 1)))
    End If


End Function

Sub ListPossibleWords()
Range(Cells(5, 1), Cells(20000, 1)).ClearContents
iRow = 5
Call ConvertToCharacter(Cells(2, 2), "")
End Sub

---

似乎是一个后构造：1.12.16.8.1.2.5.20=A.L.P.H.A.B.E.T。为什么11.2.1.6.8.12.5.20=K.B.A.G。。。等等？@peakpeak可能是K.B.A.G。。。这个算法列出了所有的可能性。好吧，也许我下周会研究这个问题，虽然我会用C++，可能递归，这是不可行的…11216812520本身就有很多可能的结果。我正试着思考如何在没有几个长时间运行的循环的情况下做到这一点……这个问题已经在线处理了好几次，包括至少两次堆栈溢出。我会试着找一个。谢谢你的回复。我已经能够编写一个脚本，现在可以这样做，并将结果输出到电子表格中。如果您喜欢AJD的答案，请确认hs答案为已回答的答案，从而将分数给予AJD。@Aldert那里的答案是最有帮助的，但我已经提供了上面的实际解决方案。检查完整答案是否有助于查看此帖子的其他人？我很高兴给予表扬。他们提供了最大的拼图块，但不是完整的拼图。每个人都可以阅读所有答案，因此他们会得出结论：答案是AJDT的一个已编制版本，从我的答案中更容易得出结论，AJD在答案的开头说明了同样多的帮助。如果我在搜索这个问题，我希望看到完整的答案，然后深入研究我是如何得到这个答案的，如果我真的有兴趣这么做的话。AJD提供的答案只在回答部分问题时有所帮助，而且您的代码仍然效率低下，因为您为每个递归调用构建了一个固定的集合，而不是只构建一次。

Public iRow As Integer

Function ConvertToCharacter(inputString, existingAnswer)
    Dim c As Collection

    Set c = New Collection
    c.Add "A", "1"
    c.Add "B", "2"
    c.Add "C", "3"
    c.Add "D", "4"
    c.Add "E", "5"
    c.Add "F", "6"
    c.Add "G", "7"
    c.Add "H", "8"
    c.Add "I", "9"
    c.Add "J", "10"
    c.Add "K", "11"
    c.Add "L", "12"
    c.Add "M", "13"
    c.Add "N", "14"
    c.Add "O", "15"
    c.Add "P", "16"
    c.Add "Q", "17"
    c.Add "R", "18"
    c.Add "S", "19"
    c.Add "T", "20"
    c.Add "U", "21"
    c.Add "V", "22"
    c.Add "W", "23"
    c.Add "X", "24"
    c.Add "Y", "25"
    c.Add "Z", "26"
    c.Add " ", "27"

    If inputString = "" Then
        Cells(iRow, 1).Value = existingAnswer
        iRow = iRow + 1
        Exit Function
    ElseIf Len(inputString) >= 2 Then
        If Int(Left(inputString, 2)) <= 27 And Int(Left(inputString, 1)) <> "0" Then Call ConvertToCharacter(Right(inputString, Len(inputString) - 2), existingAnswer & c.Item(Left(inputString, 2)))
    End If
    If inputString <> "0" And Left(inputString, 1) <> "0" Then
        Call ConvertToCharacter(Right(inputString, Len(inputString) - 1), existingAnswer & c.Item(Left(inputString, 1)))
    End If


End Function

Sub ListPossibleWords()
Range(Cells(5, 1), Cells(20000, 1)).ClearContents
iRow = 5
Call ConvertToCharacter(Cells(2, 2), "")
End Sub