[英]compare text and highlight difference
我在两个不同文本的单元格中有文本。 我试图确定两个单元格之间的差异(文本之间的差异:添加或丢失的文本)。
例子 :
A1:这是系统生成的并且不需要签名任何未经授权的使用披露传播或传播本文档是严格禁止的,并且可能是非法的
B1:这是系统生成的文件并且不需要签名未经授权使用披露传播或复制此文件是严格禁止的并且可能是有害的
单元格A1
和B1
都应仅突出显示文本差异。 我该如何实施?
这实际上是一个非常棘手的场景,但你可以这样做:
Public Sub FindDistinctSubstrings()
Dim a$, b$, i&, k&, rA As Range, rB As Range
Set rA = [a1]: a = rA
Set rB = [b1]: b = rB
k = Len(a): If Len(b) > k Then k = Len(b)
Do
i = i + 1
If Mid$(a, i, 1) <> Mid$(b, i, 1) Then
Align i, a, b, rA, rB
End If
DoEvents
Loop Until i > k
k = Len(a): If Len(b) > k Then k = Len(b)
For i = 1 To k
If Mid$(a, i, 1) = "." Then rB.Characters(i, 1).Font.Color = vbRed
If Mid$(b, i, 1) = "." Then rA.Characters(i, 1).Font.Color = vbRed
Next
Do
k = InStr(rA, "."): If k Then rA.Characters(k, 1).Delete
Loop Until k = 0
Do
k = InStr(rB, "."): If k Then rB.Characters(k, 1).Delete
Loop Until k = 0
End Sub
Private Sub Align(k&, a$, b$, rA As Range, rB As Range)
Dim i&, iMax&, nI&, nMaxI&, j&, jMax&, nJ&, nMaxJ&
Const LOOK_AHEAD_BUFFER = 30
For i = 0 To LOOK_AHEAD_BUFFER
nI = CountMatches(Space$(i) & Mid$(a, k, LOOK_AHEAD_BUFFER), Mid$(b, k, LOOK_AHEAD_BUFFER))
If nI > nMaxI Then
nMaxI = nI: iMax = i
End If
Next
For j = 0 To LOOK_AHEAD_BUFFER
nJ = CountMatches(Mid$(a, k, LOOK_AHEAD_BUFFER), Space$(j) & Mid$(b, k, LOOK_AHEAD_BUFFER))
If nJ > nMaxJ Then
nMaxJ = nJ: jMax = j
End If
Next
If nMaxI > nMaxJ Then
a = Left$(a, k - 1) & String$(iMax, ".") & Mid$(a, k)
rA = a: k = k + iMax
Else
b = Left$(b, k - 1) & String$(jMax, ".") & Mid$(b, k)
rB = b: k = k + jMax
End If
End Sub
Private Function CountMatches(a$, b$) As Long
Dim i&, k&, c&
k = Len(a): If Len(b) < k Then k = Len(b)
For i = 1 To k
If Mid$(a, i, 1) = Mid$(b, i, 1) Then c = c + 1
Next
CountMatches = c
End Function
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.