Hay una clase de diferencias muy fresco alojado por Google aquí:¿Cómo puedo usar JavaScript dentro de una macro de Excel?
http://code.google.com/p/google-diff-match-patch/
lo he usado antes en algunos sitios web, pero ahora tengo que usarlo dentro una macro de Excel para comparar el texto entre dos celdas.
Sin embargo, solo está disponible en JavaScript, Python, Java y C++, no en VBA.
Mis usuarios están limitados a Excel 2003, por lo que una solución .NET pura no funcionaría. Traducir el código a VBA manualmente tomaría demasiado tiempo y dificultaría la actualización.
Una opción que consideré era compilar el código fuente JavaScript o Java utilizando los compiladores .NET (JScript.NET o J #), usar Reflector para dar salida como VB.NET, y finalmente degradar el código VB.NET manualmente a VBA, dándome una solución pura de VBA. Después de tener problemas para compilar con cualquier compilador .NET, abandoné esta ruta.
Asumiendo que podría haber obtenido una biblioteca .NET en funcionamiento, también podría haber usado ExcelDna (http://www.codeplex.com/exceldna), un complemento de código abierto de Excel para facilitar la integración del código .NET.
Mi última idea fue alojar un objeto de Internet Explorer, enviarle el código fuente de JavaScript y llamarlo. Incluso si hiciera que esto funcionara, supongo que sería muy lento y desordenado.
ACTUALIZACIÓN: ¡Solución encontrada!
Utilicé el método WSC que se describe a continuación con la respuesta aceptada. Tenía que cambiar el código de WSC un poco para limpiar los diferenciales y me devuelva una matriz compatible con VBA de matrices:
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();
}
que registró el CSM y funcionó muy bien. El código en VBA para llamar es de la siguiente manera:
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
(I intentado mantener una única objWMIService global y objDiff alrededor, así que no tendría que crear/destruir estos para cada celda, pero no parecía para hacer una diferencia en el rendimiento.)
Luego escribí mi macro principal. Toma tres parámetros: un rango (una columna) de valores originales, un rango de valores nuevos y un rango donde el diff debe volcar los resultados. Todos son asumidos para tener la misma cantidad de filas, no tengo ninguna verificación de errores importante aquí.
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
Estas tres líneas siguientes acelerar la actualización sin estropear modo de cálculo preferido del usuario después:
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
Borrado de los diferenciales anteriores, en su caso, es importante:
Erase diffs
Este la prueba es un atajo visual para mis usuarios por lo que está claro cuando no hay ningún cambio:
ElseIf OriginalValue = NewValue Then
difftext = "No change."
Erase diffs
Else
Combine todo el texto en conjunto como el valor de la celda delta, si el texto era idéntico, insertado o eliminado:
diffs = GetDiffs(OriginalValue, NewValue)
For idiff = 0 To UBound(diffs)
thisDiff = diffs(idiff)
difftext = difftext & thisDiff(1)
Next
End If
Usted tiene que fijar el valor antes iniciar el formateo:
DeltaCell.value2 = difftext
Call FormatDiff(diffs, DeltaCell)
Next
Application.ScreenUpdating = True
Application.Calculation = CalcMode
End Sub
Aquí está el código que interpreta los diferenciales y formatea la célula delta:
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
Hay algunas oportunidades para la optimización, pero hasta ahora está funcionando bien. Gracias a todos los que ayudaron!
genial. Gustoso de trabajar para ti. En el futuro, si lo desea, puede responder su propia pregunta. Aparecerá en un cuadro de texto azul; visualmente está claro que lo has publicado. – Cheeso
El proyecto diff/merge/patch de Google ahora incluye un puerto C# (totalmente administrado). –