如何在 Excel 宏中使用 JavaScript？

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 將 Javascript 差異邏輯嵌入到 COM 組件中。這可以通過稱為“ Windows 腳本組件”的東西來實現。

這是有關創建 WSC 的教程。

Windows 腳本組件是在腳本中定義的 COM 組件。組件的介面是通過 COM，這意味著它是 VBA 友好的。該邏輯以任何與 Windows Scripting Hosting 兼容的語言實現，例如 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 file:\c:\scripts\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

引用自：https://stackoverflow.com/questions/848246