主要代码如下：
Option Explicit '这是全部代码 复制到 Excel 中，用“条件格式”来显示
Dim n1 As Integer, n2 As Integer
Dim L1 As Integer, L2 As Integer
Dim QS() As Integer, CD() As Integer, mnMAX%, mn%
Dim BWL%() '备忘录（优化）
Dim tx1$, tx2$, RS$(), LS$()
Dim fnL$, fnR$
Private Sub CmdMain_Click() '【计算】（命令按钮）
'搜索和储存“编辑位置QS”和“编辑长度CD”
Dim zn1$, zn2 As String, Tot%
Dim Tmp As Integer, j1 As Integer, k2 As Integer, r As Integer
Dim z1$, L2max%
ReDim BWL(L1, L2)
DoEvents
Form1.MousePointer = 11
DoEvents
Tot = LCS(1, 1) '调用 LCS(）函数
DoEvents
Form1.MousePointer = 0
ReDim Preserve QS(1, 0), CD(1, 0)
mn = 0
n1 = 1
n2 = 1
Do
zn1 = LS(n1)
zn2 = RS(n2)
If zn1 = zn2 Then '①
n1 = n1 + 1
If Tmp > 0 Then
CD(0, mn) = 0
CD(1, mn) = Tmp
End If
Tmp = 0
Else
If Tmp = 0 Then
mn = mn + 1
ReDim Preserve QS(1, mn)
ReDim Preserve CD(1, mn)
QS(0, mn) = n1
QS(1, mn) = n2
End If
r = 1
Do
If n1 = L1 Then
Exit Do
End If
z1 = LS(n1 + r)
If z1 = zn2 Then
For j1 = n1 To n1 + r - 1
For k2 = n2 + 1 To L2
If RS(k2) = LS(j1) Then
If BWL(j1, k2) > BWL(n1 + r, n2) Then
Exit Do ' ③2
End If
Exit For
End If
Next
Next
CD(0, mn) = r
CD(1, mn) = Tmp
n1 = n1 + r + 1
r = 0
Tmp = -1
Exit Do
End If
r = r + 1
Loop Until n1 + r > L1 '②或③2
Tmp = Tmp + 1
End If
n2 = n2 + 1 '①②或③1或③2
Loop Until ((n1 > L1) Or (n2 > L2))
If n1 <= L1 Then
If Tmp = 0 Then
mn = mn + 1
ReDim Preserve QS(1, mn)
ReDim Preserve CD(1, mn)
QS(0, mn) = n1
QS(1, mn) = n2
End If
CD(0, mn) = L1 - n1 + 1
CD(1, mn) = Tmp
Tmp = 0
End If
If n2 <= L2 Then
mn = mn + 1
ReDim Preserve QS(1, mn)
ReDim Preserve CD(1, mn)
QS(0, mn) = n1
QS(1, mn) = n2
CD(0, mn) = 0
CD(1, mn) = L2 - n2 + 1
End If
Form1.MousePointer = 0
mnMAX = mn
CmdMain.Enabled = False
If mn = 0 Then
Exit Sub '
End If
DoEvents
Mk '加分类标志、加行号、加“斜纹行”
DoEvents
End Sub
Private Function LCS(ByVal aa As Integer, ByVal bb As Integer) As Integer '递归函数
Dim r%, j1%, k2%, m%
Dim zn1$, zn2$, n1%, n2%
Dim z1$
n1 = aa
n2 = bb
Do
zn1 = LS(n1)
zn2 = RS(n2)
If zn1 = zn2 Then '①
m = m + 1
n1 = n1 + 1
Else '②或③1或③2---除了①
r = 1
Do
If n1 + r > L1 Then Exit Do '【】
z1 = LS(n1 + r)
If z1 = zn2 Then
For j1 = n1 To n1 + r - 1
For k2 = n2 + 1 To L2
If RS(k2) = LS(j1) Then
If BWL(j1, k2) = 0 Then BWL(j1, k2) = LCS(j1, k2)
If BWL(n1 + r, n2) = 0 Then BWL(n1 + r, n2) = LCS(n1 + r, n2)
If BWL(j1, k2) > BWL(n1 + r, n2) Then '
Exit Do ' ③2
End If
Exit For '离开k2循环
End If
Next k2
Next j1
m = m + 1
n1 = n1 + r + 1
r = 0
Exit Do '③1
End If
r = r + 1
Loop Until n1 + r > L1 '②或③2
End If
n2 = n2 + 1 '①②或③1或③2
Loop Until ((n1 > L1) Or (n2 > L2))
LCS = m
End Function
Private Sub Command1_Click() '复制到剪贴板
Text1.SelStart = 0
Text1.SelLength = Len(tx1)
Clipboard.Clear
Clipboard.SetText tx1
End Sub
Private Sub Command3_Click() '复制到剪贴板
Text2.SelStart = 0
Text2.SelLength = Len(tx2)
Clipboard.Clear
Clipboard.SetText tx2
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Mk() ' 加 '!'标志、加行号、加“斜纹行”
Dim hh%, pp%, mn%, i%, j%, CCDD%
Dim kh$, Lkh$, Rkh$
kh = " ///////////////////////////////////////" & vbCrLf
mn = 1: hh = 1: pp = 1
Do
If hh = QS(0, mn) And pp = QS(1, mn) Then 'A副本中外来的（插入的）行
CCDD = CD(0, mn) - CD(1, mn)
For i = 1 To Abs(CCDD)
If CCDD > 0 Then Rkh = Rkh & kh Else Lkh = Lkh & kh '/////////
Next i
For i = 0 To CD(0, mn) - 1
LS(QS(0, mn) + i) = "! " & Right$(" " & Trim$(Str$(QS(0, mn) + i)), 3) & " " & LS(QS(0, mn) + i) '加!
Next i
hh = hh + i '左边的行号
For j = 0 To CD(1, mn) - 1
RS(QS(1, mn) + j) = "! " & Right$(" " & Trim$(Str$(QS(1, mn) + j)), 3) & " " & RS(QS(1, mn) + j) '加!
Next j
pp = pp + j '右边的行号
If mn < mnMAX Then mn = mn + 1
Else 'A副本中原本就有的行
LS(hh) = " " & Right$(" " & Trim$(Str$(hh)), 3) & " " & LS(hh)
LS(hh) = Lkh & LS(hh)
Lkh = ""
RS(pp) = " " & Right$(" " & Trim$(Str$(pp)), 3) & " " & RS(pp)
RS(pp) = Rkh & RS(pp)
Rkh = ""
pp = pp + 1
hh = hh + 1
End If
Loop Until hh > L1 And pp > L2
LS(L1) = LS(L1) & vbCrLf & Lkh
RS(L2) = RS(L2) & vbCrLf & Rkh
tx1 = "": tx2 = ""
For i = 1 To L1
tx1 = tx1 & LS(i) & vbCrLf
Next i
For j = 1 To L2
tx2 = tx2 & RS(j) & vbCrLf
Next j
Text1.Text = tx1: Text2.Text = tx2
Label7.Visible = True
Command1.Visible = True '【复制】
Command3.Visible = True '【复制】
End Sub
这是自己设计的程序。如有错误和不妥，恳请指正，真诚感谢！