比较两个工作簿

时间:2019-08-16 15:25:28

标签: excel vba

我希望比较两个工作簿之间的更改。
数据看起来像这样

工作簿1:

//@version=4
strategy("bnf2")

entryTime = year == 2019 and month == 8 and hour == 14 and minute == 0
exitTime = year == 2019 and month == 8 and hour == 15 and minute == 15

strategy.entry("bnf-long", strategy.long, 20, stop= high, when=entryTime)
strategy.close("bnf-long", when = exitTime)
plot(strategy.equity)

工作簿2:

Column1     Column 2     Column 3   
Nissan      Micra        Red      
Honda       CRV          Grey      
Honda       Accord       Grey 

我想在遍历每一行时识别列之间的变化。

例如,代码应标识/输出在第2行中,第2列和第3列之间有变化,在第3行中,第1列和第2列之间有变化。

1 个答案:

答案 0 :(得分:0)

现在回答您的问题有点困难,因为您没有提供任何初步代码或希望如何进行比较的详细信息(通过MsgBox,Debug.Print,生成.xlsx或。 txt文件等)。

幸运的是,这看起来与我过去要做的事情类似,因此我有一个代码示例可以与您分享,可以帮助您入门。

要运行该示例,只需将下面的代码(1个子过程和2个函数)粘贴到模块中,然后运行该子过程。

Public Sub CompareWorkbooks()
'PURPOSE: Compare the sheets with the same name in two workbooks to make sure all the values are the same.

    'Select the 2 files manually
    Dim WbName1 As String, WbName2 As String
    WbName1 = UserSelectWorkbook
    WbName2 = UserSelectWorkbook

    'Open the 2 files if they are not open
    Dim FullFileName As String
    Dim temp() As String
    Dim FileName As String

    FullFileName = WbName1
    temp = Split(FullFileName, "\")
    FileName = temp(UBound(temp))

    Dim wb1 As Workbook, wb2 As Workbook

    If IsWorkbookOpen(FileName) = False Then
        Set wb1 = Workbooks.Open(FullFileName)
    Else
        Set wb1 = Workbooks(FileName)
    End If

    FullFileName = WbName2
    temp = Split(FullFileName, "\")
    FileName = temp(UBound(temp))

    If IsWorkbookOpen(FileName) = False Then
        Set wb2 = Workbooks.Open(FullFileName)
    Else
        Set wb2 = Workbooks(FileName)
    End If

    'Compare the 2 files
    Dim DifferenceFoundInWorkbook As Boolean

    Dim ws1 As Worksheet, ws2 As Worksheet
    For Each ws1 In wb1.Worksheets
        For Each ws2 In wb2.Worksheets

            If ws1.Name = ws2.Name Then

                Dim Range1 As Range, Range2 As Range
                Set Range1 = ws1.UsedRange
                Set Range2 = ws2.UsedRange

                Dim DifferenceFoundWithinSheets As Boolean
                DifferenceFoundWithinSheets = False 'Reset

                Dim CellNumber As Long
                CellNumber = 0 'Reset

                Dim c As Range
                For Each c In Range1

                    CellNumber = CellNumber + 1
                    If c.Value2 <> Range2.Cells(CellNumber).Value2 Then

                        Dim DoContinue As Variant
                        DoContinue = MsgBox("Different values in " & vbNewLine & _
                        "[" & wb1.Name & "]" & ws1.Name & "!" & c.Address & " (""" & Range1.Cells(CellNumber).Value2 & """)" & vbNewLine & _
                        "[" & wb2.Name & "]" & ws2.Name & "!" & c.Address & " (""" & Range2.Cells(CellNumber).Value2 & """)" & vbNewLine & vbNewLine & _
                        "Continue searching?", _
                        vbYesNoCancel, "Workbook Comparison")

                        DifferenceFoundWithinSheets = True
                        DifferenceFoundInWorkbook = True

                        Select Case DoContinue
                        Case Is = vbYes: 'Let the comparison continue
                        Case Is = vbNo: Exit Sub
                        Case Is = vbCancel: Exit Sub
                        Case Else: Exit Sub 'For when the user press the X in the top righ corner.
                        End Select

                    End If
                Next c

                If Not DifferenceFoundWithinSheets Then
                    MsgBox "No difference found between the 2 worksheets with name " & ws1.Name
                End If

            End If

        Next ws2
    Next ws1


    If Not DifferenceFoundInWorkbook Then
        MsgBox "No difference found between the 2 workbooks."
    End If

End Sub

Public Function UserSelectWorkbook() As String
'PURPOSE: Allows to select one workbook using the usual window.
'SOURCE: https://excelmacromastery.com/excel-vba-workbook/

    On Error GoTo ErrorHandler

    Dim FD As FileDialog
    Set FD = Application.FileDialog(msoFileDialogFilePicker)

    ' Open the file dialog
    With FD
        ' Set Dialog Title
        .Title = "Please Select File"

        ' Add filter
        .Filters.Add "Excel Files", "*.xls;*.xlsx;*.xlsm;*.xlsb;*.csv"

        ' Allow selection of one file only
        .AllowMultiSelect = False

        ' Display dialog
        .Show

        If FD.SelectedItems.Count <> 0 Then
            UserSelectWorkbook = FD.SelectedItems(1)
        Else
            MsgBox "Selecting a file has been cancelled. "
            UserSelectWorkbook = vbNullString
        End If
    End With

CleanUp:
    Set FD = Nothing
    Exit Function
ErrorHandler:
    MsgBox "Error: " & Err.Description
    GoTo CleanUp

End Function

Public Function IsWorkbookOpen(ByVal FullFileName As String) As Boolean

    Dim wb As Workbook
    Dim ErrNb As Long

    On Error Resume Next
    Set wb = Workbooks(FullFileName)
    ErrNb = Err.Number
    On Error GoTo 0

    Select Case ErrNb
    Case 0:         IsWorkbookOpen = True
    Case Else:      IsWorkbookOpen = False
    End Select

End Function

此代码将为您提供每个发现的差异的MsgBox窗口。您可能希望将其更改为将产生这些差异的列表并将其写入工作表的命令。

还请注意,此宏没有任何错误处理,并且没有针对在大型工作簿上运行进行优化。

编辑:

如果要将报告生成到新工作簿中,则可以使用其他版本的CompareWorkbooks宏:

Public Sub CompareWorkbooks()
'PURPOSE: Compare the sheets with the same name in two workbooks and generate a summary in a new workbook.

    'Select the 2 files manually
    Dim WbName1 As String, WbName2 As String
    WbName1 = UserSelectWorkbook
    WbName2 = UserSelectWorkbook

    'Open the 2 files if they are not open
    Dim FullFileName As String
    Dim temp() As String
    Dim FileName As String

    FullFileName = WbName1
    temp = Split(FullFileName, "\")
    FileName = temp(UBound(temp))

    Dim wb1 As Workbook, wb2 As Workbook

    If IsWorkbookOpen(FileName) = False Then
        Set wb1 = Workbooks.Open(FullFileName)
    Else
        Set wb1 = Workbooks(FileName)
    End If

    FullFileName = WbName2
    temp = Split(FullFileName, "\")
    FileName = temp(UBound(temp))

    If IsWorkbookOpen(FileName) = False Then
        Set wb2 = Workbooks.Open(FullFileName)
    Else
        Set wb2 = Workbooks(FileName)
    End If

    'Compare the 2 files
    Dim DifferenceFoundInWorkbook As Boolean

    Dim ws1 As Worksheet, ws2 As Worksheet
    For Each ws1 In wb1.Worksheets
        For Each ws2 In wb2.Worksheets

            If ws1.Name = ws2.Name Then

                Dim Range1 As Range, Range2 As Range
                Set Range1 = ws1.UsedRange
                Set Range2 = ws2.UsedRange

                Dim DifferenceFoundWithinSheets As Boolean
                DifferenceFoundWithinSheets = False 'Reset

                Dim CellNumber As Long
                CellNumber = 0 'Reset

                Dim c As Range
                For Each c In Range1

                    CellNumber = CellNumber + 1
                    If c.Value2 <> Range2.Cells(CellNumber).Value2 Then

                        Dim Counter As Long

                        Dim wbReport As Workbook
                        If Counter = 0 Then
                            Set wbReport = Workbooks.Add
                        End If

                        Counter = Counter + 1

                        wbReport.ActiveSheet.Cells(Counter, 1).Value2 = "[" & wb1.Name & "]" & ws1.Name & "!" & c.Address & " (""" & Range1.Cells(CellNumber).Value2 & """)"
                        wbReport.ActiveSheet.Cells(Counter, 2).Value2 = "[" & wb2.Name & "]" & ws2.Name & "!" & c.Address & " (""" & Range2.Cells(CellNumber).Value2 & """)"

                        DifferenceFoundInWorkbook = True

                    End If
                Next c

            End If

        Next ws2
    Next ws1


    If Not DifferenceFoundInWorkbook Then
        MsgBox "No difference found between the 2 workbooks."
    End If

End Sub