Google 托管了一个非常酷的 diff 类:

http://code.google.com/p/google-diff-match-patch/

我之前在一些网站上使用过它,但现在我需要使用它 之内 用于比较两个单元格之间的文本的 Excel 宏。

但是,它仅适用于 JavaScript、Python、Java 和 C++,不适用于 VBA。

我的用户只能使用 Excel 2003,因此纯 .NET 解决方案无法工作。手动将代码转换为 VBA 会花费太多时间并且使升级变得困难。

我考虑的一个选择是使用 .NET 编译器(JScript.NET 或 J#)编译 JavaScript 或 Java 源代码,使用 Reflector 输出为 VB.NET,最后手动将 VB.NET 代码降级为 VBA,这给了我一个纯粹的VBA 解决方案。在使用任何 .NET 编译器进行编译时遇到问题后,我放弃了这条路径。

假设我可以获得一个可用的 .NET 库,我也可以使用 ExcelDna (http://www.codeplex.com/exceldna),一个开源 Excel 插件,使 .NET 代码集成更容易。

我的最后一个想法是托管一个 Internet Explorer 对象,向其发送 JavaScript 源代码,然后调用它。即使我让它工作,我的猜测是它会非常缓慢且混乱。

更新:找到解决方案了!

我使用了下面接受的答案描述的 WSC 方法。我必须稍微更改 WSC 代码来清理差异并返回一个与 VBA 兼容的数组:

function DiffFast(text1, text2)
{
    var d = dmp.diff_main(text1, text2, true);
    dmp.diff_cleanupSemantic(d);
    var dictionary = new ActiveXObject("Scripting.Dictionary"); // VBA-compatible array
    for ( var i = 0; i < d.length; i++ ) {
    dictionary.add(i, JS2VBArray(d[i]));
    }
    return dictionary.Items();
}

function JS2VBArray(objJSArray)
{
    var dictionary = new ActiveXObject("Scripting.Dictionary");
    for (var i = 0; i < objJSArray.length; i++) {
        dictionary.add( i, objJSArray[ i ] );
        }
    return dictionary.Items();
}

我注册了 WSC,效果很好。VBA中调用的代码如下:

Public Function GetDiffs(ByVal s1 As String, ByVal s2 As String) As Variant()
    Dim objWMIService As Object
    Dim objDiff As Object
    Set objWMIService = GetObject("winmgmts:")
    Set objDiff = CreateObject("Google.DiffMatchPath.WSC")
    GetDiffs = objDiff.DiffFast(s1, s2)
    Set objDiff = Nothing
    Set objWMIService = Nothing
End Function

(我尝试保留一个全局 objWMIService 和 objDiff,这样我就不必为每个单元创建/销毁它们,但它似乎对性能没有影响。)

然后我编写了我的主要宏。它需要三个参数:原始值的范围(一列)、新值的范围以及 diff 应转储结果的范围。全部是 假定 为了具有相同的行数,我在这里没有进行任何严重的错误检查。

Public Sub DiffAndFormat(ByRef OriginalRange As Range, ByRef NewRange As Range, ByRef DeltaRange As Range)
    Dim idiff As Long
    Dim thisDiff() As Variant
    Dim diffop As String
    Dim difftext As String
    difftext = ""
    Dim diffs() As Variant
    Dim OriginalValue As String
    Dim NewValue As String
    Dim DeltaCell As Range
    Dim row As Integer
    Dim CalcMode As Integer

接下来的三行可以加快更新速度,而不会在以后破坏用户的首选计算模式:

    Application.ScreenUpdating = False
    CalcMode = Application.Calculation
    Application.Calculation = xlCalculationManual
    For row = 1 To OriginalRange.Rows.Count
        difftext = ""
        OriginalValue = OriginalRange.Cells(row, 1).Value
        NewValue = NewRange.Cells(row, 1).Value
        Set DeltaCell = DeltaRange.Cells(row, 1)
        If OriginalValue = "" And NewValue = "" Then

删除以前的差异(如果有)很重要:

            Erase diffs

此测试对于我的用户来说是一个视觉快捷方式,因此当根本没有任何更改时就很清楚:

        ElseIf OriginalValue = NewValue Then
            difftext = "No change."
            Erase diffs
        Else

将所有文本组合在一起作为增量单元格值,无论文本是否相同、插入或删除:

            diffs = GetDiffs(OriginalValue, NewValue)
            For idiff = 0 To UBound(diffs)
                thisDiff = diffs(idiff)
                difftext = difftext & thisDiff(1)
            Next
        End If

你必须设置该值 开始格式化:

        DeltaCell.value2 = difftext
        Call FormatDiff(diffs, DeltaCell)
    Next
    Application.ScreenUpdating = True
    Application.Calculation = CalcMode
End Sub

以下是解释差异并格式化增量单元格的代码:

Public Sub FormatDiff(ByRef diffs() As Variant, ByVal cell As Range)
    Dim idiff As Long
    Dim thisDiff() As Variant
    Dim diffop As String
    Dim difftext As String
    cell.Font.Strikethrough = False
    cell.Font.ColorIndex = 0
    cell.Font.Bold = False
    If Not diffs Then Exit Sub
    Dim lastlen As Long
    Dim thislen As Long
    lastlen = 1
    For idiff = 0 To UBound(diffs)
        thisDiff = diffs(idiff)
        diffop = thisDiff(0)
        thislen = Len(thisDiff(1))
        Select Case diffop
            Case -1
                cell.Characters(lastlen, thislen).Font.Strikethrough = True
                cell.Characters(lastlen, thislen).Font.ColorIndex = 16 ' Dark Gray http://www.microsoft.com/technet/scriptcenter/resources/officetips/mar05/tips0329.mspx
            Case 1
                cell.Characters(lastlen, thislen).Font.Bold = True
                cell.Characters(lastlen, thislen).Font.ColorIndex = 32 ' Blue
        End Select
        lastlen = lastlen + thislen
    Next
End Sub

有一些优化的机会,但到目前为止效果很好。感谢所有提供帮助的人!

有帮助吗?

解决方案

的最简单的方法可以是嵌入的Javascript DIFF逻辑成直接使用Javascript COM组件。这通过一种叫做“ Windows脚本组件是可能的”。

下面的创建自来水公司的教程。

一个Windows脚本组件是在脚本中定义的COM组件。到部件的接口是通过COM,这意味着它是VBA友好。逻辑是在任何Windows脚本主机兼容的语言来实现,如JavaScript或者VBScript。该WSC在单个XML文件,其中嵌入逻辑,部件类ID,这些方法,注册逻辑,等等定义。

还有提供给工具在创建WSC 帮助。基本上,它是问你的问题,并在XML模板填充向导式的东西。我自己,我刚开始用一个例子的.wsc文件,并用文本编辑器编辑它的手。这是不言自明。

在脚本中定义的这种方式(在的.wsc文件)COM组件是可调用就像任何其他COM组件,从能够与COM跳舞任何环境。

<强>更新:我花了几分钟并产生用于GoogleDiff的WSC。这

<?xml version="1.0"?>

<package>

<component id="Cheeso.Google.DiffMatchPatch">

  <comment>
    COM Wrapper on the Diff/Match/Patch logic published by Google at http://code.google.com/p/google-diff-match-patch/.
  </comment>

<?component error="true" debug="true"?>

<registration
  description="WSC Component for Google Diff/Match/Patch"
  progid="Cheeso.Google.DiffMatchPatch"
  version="1.00"
  classid="{36e400d0-32f7-4778-a521-2a5e1dd7d11c}"
  remotable="False">

  <script language="VBScript">
  <![CDATA[

    strComponent = "Cheeso's COM wrapper for Google Diff/Match/Patch"

    Function Register
      MsgBox strComponent & " - registered."
    End Function

    Function Unregister
      MsgBox strComponent & " - unregistered."
    End Function

  ]]>
  </script>
</registration>


<public>
  <method name="Diff">
    <parameter name="text1"/>
    <parameter name="text2"/>
  </method>
  <method name="DiffFast">
    <parameter name="text1"/>
    <parameter name="text2"/>
  </method>
</public>


<script language="Javascript">
<![CDATA[


    // insert original google diff code here...


// public methods on the component
var dpm = new diff_match_patch();


function Diff(text1, text2)
{
   return dpm.diff_main(text1, text2, false);
}


function DiffFast(text1, text2)
{
   return dpm.diff_main(text1, text2, true);
}


]]>
</script>

</component>

</package>

要使用的东西,你必须注册。在资源管理器中,右键单击它,选择“注册”。或者,从所述命令行:     REGSVR32文件:\ C:\脚本\ GoogleDiff.wsc

我没有尝试使用它从VBA,但这里是使用组件的一些VBScript代码。

Sub TestDiff()
    dim t1 
    t1 = "The quick brown fox jumped over the lazy dog."

    dim t2 
    t2 = "The large fat elephant jumped over the cowering flea."

    WScript.echo("")

    WScript.echo("Instantiating a Diff Component ...")
    dim d
    set d = WScript.CreateObject("Cheeso.Google.DiffMatchPatch")

    WScript.echo("Doing the Diff...")
    x = d.Diff(t1, t2)

    WScript.echo("")
    WScript.echo("Result was of type: " & TypeName(x))
    ' result is all the diffs, joined by commas.  
    ' Each diff is an integer (position), and a string.  These are separated by commas.
    WScript.echo("Result : " & x)

    WScript.echo("Transform result...")
    z= Split(x, ",")
    WScript.echo("")
    redim diffs(ubound(z)/2)
    i = 0
    j = 0
    For Each item in z
      If (j = 0) then
        diffs(i) = item
        j = j+ 1      
      Else 
          diffs(i) = diffs(i) & "," & item
        i = i + 1
        j = 0
      End If
    Next

    WScript.echo("Results:")
    For Each item in diffs
      WScript.echo("  " & item)
    Next

    WScript.echo("Done.")

End Sub

其他提示

Windows脚本发动机将允许您运行JavaScript库。它运作良好,在我的经验。

我的建议是,不管你做的,你把它包装在一个COM包装。 VBA涉及最好与COM对象,所以你可以编译为.NET组件则公开为使用.NET的互操作功能的COM对象。

作为替代你也可以考虑使用Windows脚本宿主对象执行JavaScript文件,并返回结果。

这是另一种可以考虑的选择,尽管我绝不是说它是最好的选择。

  • 确保 Python 版本可以在 IronPython 中编译。(这里应该不会有什么问题,或者最多只是少量的移植。)
  • 使用 C# 创建 Excel 加载项库并从中引用 IronPython。
  • 在 C# Excel 加载项中包含必要的功能。
许可以下: CC-BY-SA归因
不隶属于 StackOverflow
scroll top