【发布时间】：2010-10-25 07:07:42
【问题描述】：
这里有一个由 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
有一些优化的机会，但到目前为止它工作得很好。感谢所有帮助过的人！
【问题讨论】：
-
酷。很高兴它对你有效。将来，如果您愿意，可以回答自己的问题。它将在蓝色文本框中弹出；从视觉上看，您已经发布了它。
-
Google diff/merge/patch 项目现在包括一个（完全托管的）C# 端口。
标签： .net javascript excel vba j#