程序界面
从上图可以看出，LCS的解在某些情况下并非唯一的，下面的程序将用二种方法生成LCS串，可以得到上述2种不同的结果。
Private Sub CommandButton1_Click() ''2021-1-24 KMP
Dim S, T As String
Dim i, j, n, m As Integer
Dim Nexj() As Integer
'' S = InputBox("输入源字符串S:")
'' T = InputBox("请输入待查找的字符串T")
S = Cells(3, "K")
T = Cells(4, "K")
If S = "" Or T = "" Then Exit Sub
m = Len(S)
n = Len(T)
ReDim Nexj(1 To n)
Call getNext(T, Nexj)
i = 1: j = 1
While i <= m - n + 1
If Mid(S, i, 1) = Mid(T, j, 1) Then
i = i + 1
j = j + 1
Else
j = Nexj(j)
End If
If j = 0 Then
j = 1
i = i + 1
End If
If j > n Then ''匹配成功
'' MsgBox "匹配成功的起始位置：" & Str(i - n), vbOKOnly, "匹配成功！"
Cells(5, "K") = i - n
Exit Sub
End If
Wend
If i > m - n + 1 Then
'' MsgBox "没有找到！", vbOKOnly, "失败！"
Cells(5, "K") = "没找到！"
End If
End Sub
KMP主程序（按钮）
Private Sub CommandButton2_Click() ‘’ LCS
Dim a, b As String
Dim i, j, n, m As Integer
Dim LenC() As Integer
Dim 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 Sub
m = 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 Integer
i = 1
nextj(1) = 0
j = 0
While i < Len(T)
If j = 0 Then
i = i + 1
j = j + 1
nextj(i) = j
Else
If Mid(T, i, 1) = Mid(T, j, 1) Then
i = i + 1
j = j + 1
nextj(i) = j
Else
j = nextj(j)
End If
End If
Wend
End Sub
Sub Lcs_Len(ByVal a As String, ByVal b As String, ByRef c() As Integer, ByRef arr() As Integer)
Dim i, j As Integer
Dim m, n As Integer
m = Len(a)
n = Len(b)
For i = 0 To m
c(i, 0) = 0
Next i
For i = 0 To n
c(0, i) = 0
Next i
For i = 1 To m
For j = 1 To n
If Mid(a, i, 1) = Mid(b, j, 1) Then
c(i, j) = c(i - 1, j - 1) + 1
arr(i, j) = 0
Else
If c(i - 1, j) > c(i, j - 1) Then
c(i, j) = c(i - 1, j)
arr(i, j) = 1
Else
c(i, j) = c(i, j - 1)
arr(i, j) = 2
End If
End If
Next j
Next i
End Sub
Public Function BuildLCS(ByVal a As String, ByRef LCS() As Integer) As String ''构造LCS字符串 2022-1-25
Dim m, n As Integer '' a 串长 m，b串长 n , LCS()数组 m*n
Dim i, j, k As Integer
m = UBound(LCS, 1) ''1...m
n = UBound(LCS, 2)
k = LCS(m, n) '' LCS=k
i = m
j = n
BuildLCS = ""
While k > 0 ''LCS字串只有k个字符
If LCS(i, j) = LCS(i - 1, j) Then
i = i - 1
Else
If LCS(i, j) = LCS(i, j - 1) Then
j = j - 1
Else
BuildLCS = Mid(a, i, 1) & BuildLCS ''上，左 都不相等时，必然是要找的字符
i = i - 1
j = j - 1
k = k - 1
End If
End If
Wend
End Function
Public 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 Function
If 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)函数，LCS里的计算LCS数组的过程，以及回溯构造LCS字符串的递归与非递归的函数。
值得一提的是，网上大多数教程都是以类C或java类语言写成的，如今以VBA语言（镶嵌在EXCEL里）写成，以图新鲜和供有需要的同学参考。
其次，在模块1中的Function BLCS()采用递归的方法生成LCS串，可以看出VBA是支持递归函数的。
最后一点：LCS的解并不是唯一的，从第一张截图可以看出。本程序采用2种方法构造LCS字串，所得结果都是正确的。
