Hướng dẫn javascript run excel macro - javascript chạy macro excel

Có một lớp khác biệt thực sự thú vị do Google lưu trữ ở đây:

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

Tôi đã sử dụng nó trước đây trên một số trang web, nhưng bây giờ tôi cần sử dụng nó trong 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, vì vậy 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à gây khó khăn cho việc nâng cấp.

Một tùy chọn mà tôi đã xem xét là biên dịch mã nguồn JavaScript hoặc Java bằng trình biên dịch .NET (JScript.NET hoặc J #), sử dụng Reflector để xuất ra dưới dạng VB.NET, sau đó cuối cùng hạ cấp mã VB.NET theo cách thủ công xuống VBA, mang lại cho tôi sự thuần khiết Giải pháp VBA. Sau khi gặp sự cố khi biên dịch nó với bất kỳ trình biên dịch .NET nào, tôi đã bỏ qua đường dẫn này.

Giả sử tôi có thể có một thư viện .NET đang hoạt động, tôi cũng có thể sử dụng ExcelDna ( http://www.codeplex.com/exceldna ), một bổ trợ Excel mã nguồn mở để làm cho việc 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 chạp 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ởi câu trả lời được chấp nhận. Tôi đã phải thay đổi mã WSC một chút để xóa các khác biệt và trả lại cho tôi một dãy mảng tương thích với 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();
}

Tôi đã đăng ký WSC và nó hoạt động tốt. Mã trong VBA để gọi nó 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 và objDiff toàn cầu duy nhất xung quanh để tôi không phải tạo / hủy chúng cho mỗi ô, nhưng nó dường như không tạo ra 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) giá trị ban đầu, một phạm vi giá trị mới và một phạm vi mà sự khác biệt sẽ kết xuất kết quả. Tất cả đều được giả định là có cùng một số hàng, tôi không có bất kỳ quá trình kiểm tra lỗi nghiêm trọng nào đang diễn ra ở đâ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 này giúp tăng tốc cập nhật mà không làm hỏng chế độ tính toán ưa thích của người dùng sau này:

    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

Xóa các khác biệt trước đó, nếu có, là quan trọng:

            Erase diffs

Thử nghiệm này là một lối tắt trực quan cho người dùng của tôi nên rất rõ ràng khi không có thay đổi nào:

        ElseIf OriginalValue = NewValue Then
            difftext = "No change."
            Erase diffs
        Else

Kết hợp tất cả văn bản với nhau dưới dạng giá trị ô delta, cho dù văn bản giống hệt nhau, được chèn hay bị 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 đặt giá trị trước khi 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ã diễn giải sự 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 đỡ!

21 hữu ích 2 bình luận 50k xem chia sẻ 2 bình luận 50k xem chia sẻ