【问题标题】:compare text and highlight difference比较文本并突出显示差异
【发布时间】:2020-01-17 19:44:01
【问题描述】:

我在两个具有不同文本的单元格中有文本。我正在尝试识别两个单元格之间的差异(文本之间的差异:添加或丢失的文本)。

例子:

A1:这是系统生成的,不需要签名Anyun授权使用披露传播本文档的使用是严格禁止的,并且可能是非法的

B1:这是系统生成的文档,不需要签名未经授权的使用披露传播或复制此文档是严格禁止的,并且可能不妥

A1B1 两个单元格应仅突出显示文本差异。我该如何实现?

【问题讨论】:

标签: vba excel


【解决方案1】:

这实际上是一个非常棘手的场景,但你可以这样做:

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

【讨论】:

  • 哪些段落失败了?你能在这里列出它们吗?
  • 我需要比较以下段落:
  • A1:所有付款均受制于同一客户有责任按照 Airtel 指定的此类费率支付附加费,不时建议客户全额支付应付金额以及延迟付款费用(ifany)客户根据本收据进行的付款,所有索赔均受司法管辖>
  • B1:所有付款均受制于相同的客户有责任支付附加费征收的延迟付款数据,由 Airtel 不时指定客户建议全额支付应付金额以及延迟付款费用,如果客户在此收据中进行的付款,则在任何情况下都不得使用完整的和最终解决方案>索赔主题
  • 如果我比较长的段落,Excel 会被击中......请在这方面提供帮助,它真的节省了我太多的时间......提前谢谢
猜你喜欢
  • 2017-06-06
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2018-08-08
  • 2013-05-12
  • 1970-01-01
相关资源
最近更新 更多