关于加快此代码的任何建议吗？

Question

好吧，我有下面的代码，它在A列第1到18行中使用18个不同的单词，并在所有不同的组合中尝试它们以找到7个单词的回文。我很确定代码会完成它，但是它只搜索很长时间。我知道有一种方法可以检查组合的第一个字母和最后一个字母，以确保它们是相同的，在代码通过REVERSE函数运行它们之前，我只是不知道该怎么做。我对此很陌生，换句话说，每次将7个单词放在一起时，如果不必通过REVERSE函数，将节省大量时间，并验证首字母和尾字母比赛会做到这一点。预先感谢您的任何帮助

 Sub SevenDrome()

Dim count As Integer

count = 0

Dim wordtest As String
Dim wordpal As String

For j = 1 To 18
   For k = 1 To 18
      For l = 1 To 18
         For m = 1 To 18
            For n = 1 To 18
               For o = 1 To 18
                  For p = 1 To 18

wordtest = Cells(j, 1) & Cells(k, 1) & Cells(l, 1) & Cells(m, 1) & Cells(n, 1) & Cells(o, 1) & Cells(p, 1)
wordpal = REVERSE(wordtest)

If wordtest = wordpal Then
count = count + 1

Cells(count, 7) = wordtest

End If
                  Next p
               Next o
            Next n
         Next m
      Next l
   Next k
Next j

End Sub

Answer 1

[尝试，这将导致104,976耗时不到2秒。

Sub test()
    Dim a(1 To 18)
    Dim vR(1 To 1000000, 1 To 1)
    Dim cnt As Long
    Dim i As Integer, k As Integer, l As Integer
    Dim m As Integer, n As Integer, o As Integer

    For i = 1 To 18
        a(i) = Range("a" & i)
    Next i

    For j = 1 To 18
        For k = 1 To 18
            If a(j) = a(k) Then
                For l = 1 To 18
                    For m = 1 To 18
                        If a(l) = a(m) Then
                           For n = 1 To 18
                              For o = 1 To 18
                                If a(n) = a(o) Then
                                    For p = 1 To 18
                                       cnt = cnt + 1
                                       vR(cnt, 1) = a(j) & a(l) & a(n) & a(p) & a(o) & a(m) & a(k)
                                       DoEvents
                                    Next p
                                End If
                              Next o
                           Next n
                        End If
                    Next m
                Next l
            End If
        Next k
    Next j
    Range("g1").Resize(cnt) = vR
End Sub

数据图像

结果图像

如果每个单元格的字符数超过2，则可以执行以下操作。

Sub test2()
    Dim a(1 To 18)
    Dim vR(1 To 1000000, 1 To 1)
    Dim cnt As Long
    Dim i As Integer, k As Integer, l As Integer
    Dim m As Integer, n As Integer, o As Integer

    For i = 1 To 18
        a(i) = Range("a" & i)
    Next i

    For j = 1 To 18
        For k = 1 To 18
            If a(j) = Reverse(a(k)) Then
                For l = 1 To 18
                    For m = 1 To 18
                        If a(l) = Reverse(a(m)) Then
                           For n = 1 To 18
                              For o = 1 To 18
                                If a(n) = Reverse(a(o)) Then
                                    For p = 1 To 18
                                       cnt = cnt + 1
                                       vR(cnt, 1) = a(j) & a(l) & a(n) & a(p) & a(o) & a(m) & a(k)
                                       DoEvents
                                    Next p
                                End If
                              Next o
                           Next n
                        End If
                    Next m
                Next l
            End If
        Next k
    Next j
    Range("g1").CurrentRegion.Clear
    If cnt Then
        Range("g1").Resize(cnt) = vR
    End If
End Sub

Function Reverse(s)
    Dim i As Integer
    Dim myS As String
    For i = Len(s) To 1 Step -1
        myS = myS & Mid(s, i, 1)
    Next i
    Reverse = myS

End Function

案例2数据

案例2结果