主要代码如下：
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
这是自己设计的程序。如有错误和不妥，恳请指正，真诚感谢！
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
这是自己设计的程序。如有错误和不妥，恳请指正，真诚感谢！
