Jest to naprawdę super klasa diff hostowane przez Google tutaj:Jak mogę używać JavaScriptu w makrze programu Excel?
http://code.google.com/p/google-diff-match-patch/
Używałem go wcześniej na kilku stronach internetowych, ale teraz muszę go używać ciągu Excel makro porównać tekst między dwiema komórkami.
Jest jednak dostępna tylko w językach JavaScript, Python, Java i C++, a nie VBA.
Moi użytkownicy są ograniczeni do programu Excel 2003, więc czyste rozwiązanie .NET nie będzie działać. Ręczne przetłumaczenie kodu na VBA zajęłoby zbyt dużo czasu i utrudniłoby aktualizację.
Jedną z opcji, którą rozważałem, było skompilowanie źródła JavaScript lub Java przy użyciu kompilatorów .NET (JScript.NET lub J #), użycie Reflectora do wyprowadzenia jako VB.NET, a następnie w końcu ręczne obniżenie kodu VB.NET do VBA, dając mi czyste rozwiązanie VBA. Po problemach z kompilacją z dowolnym kompilatorem .NET, porzuciłem tę ścieżkę.
Zakładając, że mogłem uzyskać działającą bibliotekę .NET, mogłem również użyć ExcelDna (http://www.codeplex.com/exceldna), open-source Excel, aby ułatwić integrację kodu .NET.
Mój ostatni pomysł polegał na obsłudze obiektu Internet Explorer, wysłaniu go źródłu kodu JavaScript i wywołaniu go. Nawet jeśli mam to do roboty, domyślam się, że byłby wolny od brudu i bałagan.
AKTUALIZACJA: Rozwiązanie zostało znalezione!
Użyłem metody WSC opisanej poniżej przez zaakceptowaną odpowiedź. Musiałem zmienić kod WSC trochę oczyścić dyferencjału i dać mi powrotem VBA zgodnego tablicy tablic:
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();
}
Zarejestrowałem WSC i to działało dobrze. Kod w VBA dla nazywając ją następująco:
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
(próbowałem utrzymanie jednolitego globalnego objWMIService i objDiff wokół, więc nie będzie musiał tworzyć/zniszczyć tych dla każdej komórki, ale nie wydaje aby zrobić różnicę w wydajności.)
Napisałem wtedy moje główne makro. Ma trzy parametry: zakres (jedna kolumna) oryginalnych wartości, zakres nowych wartości i zakres, w którym różnica powinna zrzucać wyniki. Wszystkie są zakłada, aby mieć taką samą liczbę wierszy, nie mam tutaj żadnego poważnego sprawdzania błędów.
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
These najbliższych trzech liniach przyspieszyć aktualizację bez botching preferowany tryb obliczania użytkownika później:
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
usuwając poprzednią dyferencjału, jeśli w ogóle, jest ważne:
Erase diffs
ten test jest wizualnym skrótem dla moich użytkowników, więc jasne jest, że nie ma żadnych zmian:
ElseIf OriginalValue = NewValue Then
difftext = "No change."
Erase diffs
Else
Kombajny cały tekst razem jako wartość komórki d, czy tekst był identyczny, wstawione lub usunięte:
diffs = GetDiffs(OriginalValue, NewValue)
For idiff = 0 To UBound(diffs)
thisDiff = diffs(idiff)
difftext = difftext & thisDiff(1)
Next
End If
Trzeba ustawić wartość przed rozpoczęciem formatowania:
DeltaCell.value2 = difftext
Call FormatDiff(diffs, DeltaCell)
Next
Application.ScreenUpdating = True
Application.Calculation = CalcMode
End Sub
Oto kod, który interpretuje dyferencjału i formatuje komórki d:
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
Istnieje kilka możliwości optymalizacji, ale jak na razie wszystko działa dobrze. Dziękuję wszystkim, którzy pomogli!
fajna. Cieszę się, że to działało dla ciebie. W przyszłości, jeśli chcesz, możesz odpowiedzieć na własne pytanie. Pojawi się w niebieskim polu tekstowym; wizualnie jest jasne, że je opublikowałeś. – Cheeso
Projekt różnic/poprawek/poprawek Google zawiera teraz (w pełni zarządzany) port C#. –