Có một lớp khác thực sự mát mẻ lưu trữ bởi Google ở đây:Tôi làm cách nào để sử dụng JavaScript trong macro Excel?
http://code.google.com/p/google-diff-match-patch/
Tôi đã sử dụng nó trước khi vào một vài trang web, nhưng bây giờ tôi cần phải sử dụng nó trong một macro Excel để so sánh văn bản giữa hai ô.
Tuy nhiên, nó chỉ có sẵn trong JavaScript, Python, Java và C++ chứ không phải VBA.
Người dùng của tôi bị giới hạn trong Excel 2003, do đó, một giải pháp .NET thuần túy sẽ không hoạt động. Việc dịch mã sang VBA theo cách thủ công sẽ mất quá nhiều thời gian và làm cho việc nâng cấp trở nên khó khăn.
Một tùy chọn tôi xem là biên dịch mã nguồn JavaScript hoặc Java bằng cách sử dụng trình biên dịch .NET (JScript.NET hoặc J #), sử dụng Reflector để xuất dưới dạng VB.NET, sau đó cuối cùng hạ cấp mã VB.NET theo cách thủ công thành VBA, cho tôi một giải pháp VBA thuần túy. Sau khi có vấn đề nhận được nó để biên dịch với bất kỳ trình biên dịch .NET, tôi bỏ qua con đường này.
Giả sử tôi có thể đã nhận được thư viện .NET hoạt động, tôi cũng có thể đã sử dụng ExcelDna (http://www.codeplex.com/exceldna), một phần bổ trợ Excel nguồn mở để làm cho tích hợp mã .NET dễ dàng hơn.
Ý tưởng cuối cùng của tôi là lưu trữ một đối tượng Internet Explorer, gửi cho nó nguồn JavaScript và gọi nó. Ngay cả khi tôi làm việc này, tôi đoán là nó sẽ rất chậm và lộn xộn.
CẬP NHẬT: Tìm thấy giải pháp!
Tôi đã sử dụng phương pháp WSC được mô tả bên dưới bằng câu trả lời được chấp nhận. Tôi đã phải thay đổi mã WSC một chút để dọn dẹp diffs và đưa tôi trở lại một mảng VBA tương thích của mảng:
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();
}
Tôi đã đăng ký WSC và nó chỉ làm việc tốt. Các mã trong VBA để gọi nó là như sau:
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
(Tôi cố gắng giữ một objWMIService toàn cầu duy nhất và objDiff xung quanh vì vậy tôi sẽ không phải tạo/phá hủy những cho mỗi tế bào, nhưng nó không có vẻ để tạo sự khác biệt về hiệu suất.)
Sau đó tôi đã viết macro chính của mình. Nó có ba tham số: một phạm vi (một cột) của các giá trị ban đầu, một loạt các giá trị mới, và một phạm vi nơi khác biệt nên đổ kết quả. Tất cả là giả định để có cùng số hàng, tôi không có bất kỳ kiểm tra lỗi nghiêm trọng nào xảy ra tại đây.
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
Ba dòng tiếp theo tăng tốc độ cập nhật mà không botching chế độ tính ưa thích của người dùng sau:
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
Tẩy xoá diffs trước, nếu có, là rất quan trọng:
Erase diffs
này kiểm tra là lối tắt trực quan cho người dùng của tôi để rõ ràng khi không có thay đổi gì cả:
ElseIf OriginalValue = NewValue Then
difftext = "No change."
Erase diffs
Else
Kết hợp tất cả các văn bản với nhau như những giá trị của ô tam giác, cho dù văn bản là giống hệt nhau, chèn, hoặc xóa:
diffs = GetDiffs(OriginalValue, NewValue)
For idiff = 0 To UBound(diffs)
thisDiff = diffs(idiff)
difftext = difftext & thisDiff(1)
Next
End If
Bạn phải thiết lập giá trị trước bắt đầu định dạng:
DeltaCell.value2 = difftext
Call FormatDiff(diffs, DeltaCell)
Next
Application.ScreenUpdating = True
Application.Calculation = CalcMode
End Sub
Đây là mã giải thích các khác biệt và định dạng ô 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
Có một số cơ hội để tối ưu hóa, nhưng cho đến nay nó vẫn hoạt động tốt. Cảm ơn mọi người đã giúp đỡ!
. Vui mừng nó đã làm việc cho bạn. Trong tương lai, nếu bạn thích bạn có thể trả lời câu hỏi của riêng bạn. Nó sẽ bật lên trong một hộp văn bản màu xanh; trực quan rõ ràng là bạn đã đăng nó. – Cheeso
Dự án Google diff/merge/patch hiện bao gồm một cổng C# (được quản lý hoàn toàn). –