程序界面，包含了KMP算法和LCS算法。

從上圖可以看出，LCS的解在某些情況下并非唯一的，下面的程序將用二種方法生成LCS串，可以得到上述2種不同的結果。

Private Sub CommandButton1_Click() ''2021-1-24 KMPDim S, T As StringDim i, j, n, m As IntegerDim Nexj() As Integer'' S = InputBox("輸入源字符串S:") '' T = InputBox("請輸入待查找的字符串T")S = Cells(3, "K")T = Cells(4, "K")If S = "" Or T = "" Then Exit Subm = Len(S)n = Len(T)ReDim Nexj(1 To n)Call getNext(T, Nexj)i = 1: j = 1While i <= m - n + 1If Mid(S, i, 1) = Mid(T, j, 1) Theni = i + 1j = j + 1Elsej = Nexj(j)End IfIf j = 0 Thenj = 1i = i + 1End IfIf j > n Then ''匹配成功 '' MsgBox "匹配成功的起始位置：" & Str(i - n), vbOKOnly, "匹配成功！"Cells(5, "K") = i - nExit SubEnd IfWendIf i > m - n + 1 Then '' MsgBox "沒有找到！", vbOKOnly, "失敗！"Cells(5, "K") = "沒找到！"End IfEnd Sub

KMP主程序（按鈕）

Private Sub CommandButton2_Click() '' LCSDim a, b As StringDim i, j, n, m As IntegerDim LenC() As IntegerDim ArrowC() As Integer '' \ 0 , | 1, <- 2 記錄回溯的方向'' a = InputBox("輸入字符串a:", "A字符串") '' b = InputBox("輸入字符串b:", "B字符串")a = Cells(12, "F")b = Cells(13, "F")If a = "" Or b = "" Then Exit Subm = Len(a)n = Len(b)ReDim LenC(0 To m, 0 To n)ReDim ArrowC(1 To m, 1 To n)Call Lcs_Len(a, b, LenC, ArrowC) ''求數組Cells(14, "F") = BLCS(a, m, n, ArrowC) ''輸出，遞歸算法Cells(15, "F") = BuildLCS(a, LenC) ''非遞歸MsgBox "Oooooooook！！！"'' Debug.Print "*******************" '' For i = 1 To m '' For j = 1 To n '' Debug.Print ArrowC(i, j); '' Next j '' Debug.Print '' Next i '' Debug.Print a, b '' Debug.Print "LCS="; BLCS(a, m, n, ArrowC)End Sub

LCS主程序（按鈕）

Sub getNext(ByVal T As String, ByRef nextj() As Integer)Dim i, j As Integeri = 1nextj(1) = 0j = 0While i < Len(T)If j = 0 Theni = i + 1j = j + 1nextj(i) = jElseIf Mid(T, i, 1) = Mid(T, j, 1) Theni = i + 1j = j + 1nextj(i) = jElsej = nextj(j)End IfEnd IfWendEnd SubSub Lcs_Len(ByVal a As String, ByVal b As String, ByRef c() As Integer, ByRef arr() As Integer)Dim i, j As IntegerDim m, n As Integerm = Len(a)n = Len(b)For i = 0 To mc(i, 0) = 0Next iFor i = 0 To nc(0, i) = 0Next iFor i = 1 To mFor j = 1 To nIf Mid(a, i, 1) = Mid(b, j, 1) Thenc(i, j) = c(i - 1, j - 1) + 1arr(i, j) = 0ElseIf c(i - 1, j) > c(i, j - 1) Thenc(i, j) = c(i - 1, j)arr(i, j) = 1Elsec(i, j) = c(i, j - 1)arr(i, j) = 2End IfEnd IfNext jNext iEnd SubPublic Function BuildLCS(ByVal a As String, ByRef LCS() As Integer) As String ''構造LCS字符串 2022-1-25Dim m, n As Integer '' a 串長 m，b串長 n , LCS()數組 m*nDim i, j, k As Integerm = UBound(LCS, 1) ''1...mn = UBound(LCS, 2)k = LCS(m, n) '' LCS=ki = mj = nBuildLCS = ""While k > 0 ''LCS字串只有k個字符If LCS(i, j) = LCS(i - 1, j) Theni = i - 1ElseIf LCS(i, j) = LCS(i, j - 1) Thenj = j - 1ElseBuildLCS = Mid(a, i, 1) & BuildLCS ''上，左 都不相等時，必然是要找的字符i = i - 1j = j - 1k = k - 1End IfEnd IfWendEnd FunctionPublic Function BLCS(ByVal aaa As String, ByVal i As Integer, ByVal j As Integer, ByRef Ar() As Integer) As String ''采用遞歸的方法構造LCS串If i = 0 Or j = 0 Then Exit FunctionIf Ar(i, j) = 0 Then BLCS = BLCS(aaa, i - 1, j - 1, Ar) & Mid(aaa, i, 1)If Ar(i, j) = 1 Then BLCS = BLCS(aaa, i - 1, j, Ar)If Ar(i, j) = 2 Then BLCS = BLCS(aaa, i, j - 1, Ar)End Function

模塊1，其中包含了KMP算法里的核心：求next(j)的函數Sub getNext()，LCS里的計算LCS數組的過程Sub Lcs_Len()，以及回溯構造LCS字符串的遞歸與非遞歸的函數Public Function BLCS( )、Public Function BuildLCS( )。
值得一提的是，網上大多數教程都是以類C或java類語言寫成的，如今以VBA（鑲嵌在EXCEL里）寫成，以圖新鮮和供有需要的同學參考。
其次，在模塊1中的Function BLCS()采用遞歸的方法生成LCS串，可以看出VBA是支持遞歸函數的以及它的實現過程。
最后一點：LCS的解并不是唯一的，從第一張截圖可以看出。本程序采用2種方法構造LCS字串，所得結果都是正確的。

總結

以上是生活随笔為你收集整理的VBA实现KMP和LCS算法的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。