Там действительно крутой класс дифф организованный Google здесь:Как я могу использовать JavaScript в макросе Excel?
http://code.google.com/p/google-diff-match-patch/
Я использовал его раньше на нескольких веб-сайтов, но теперь мне нужно использовать его в Excel макрос для сравнения текста между двумя ячейками.
Однако он доступен только на JavaScript, Python, Java и C++, а не на VBA.
Мои пользователи ограничены Excel 2003, поэтому чистое .NET-решение не будет работать. Перевод кода на VBA вручную займет слишком много времени и затруднит процесс обновления.
Один из вариантов, который я рассматривал, заключался в том, чтобы скомпилировать исходный код JavaScript или Java с помощью компиляторов .NET (JScript.NET или J #), использовать 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
Этой следующей три строки ускорить обновление без botching предпочтительного режима вычисления пользователя позже:
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
Этого test - это визуальный ярлык для моих пользователей, поэтому ясно, когда изменений нет:
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
Есть некоторые возможности для оптимизации, но пока это работает нормально. Спасибо всем, кто помог!
прохладный. Рад, что это сработало для вас. В будущем, если хотите, вы можете ответить на свой вопрос. Он появится в синем текстовом поле; визуально ясно, что вы разместили его. – Cheeso
Проект Google diff/merge/patch теперь включает (полностью управляемый) порт C#. –