Как я могу использовать JavaScript в макросе Excel?

Theres действительно классный класс diff, размещенный здесь Google:

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

Я использовал его раньше на нескольких веб-сайтах, но теперь мне нужно использовать его в макросе Excel для сравнения текста между двумя ячейками.

Однако он доступен только в JavaScript, Python, Java и С++, а не в 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, чтобы очистить diff и вернуть мне массив массивов, совместимый с 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

Здесь код, который интерпретирует diff и форматирует дельта-ячейку:

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

Есть некоторые возможности для оптимизации, но пока это работает нормально. Спасибо всем, кто помог!

Ответы

<?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 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>

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