使用VBA比较整个Excel文档并输出一个新文档,其中包含重复的汇总/总计

时间:2018-05-31 00:39:15

标签: excel vba

我目前有一个脚本(从SO中蹒跚而行),它比较两个文档(50列x 1600行)并创建一个包含差异的新文档。

由于它是预期的转换,通常会在很多(每个)时间内重复出现相同的差异。

无论如何都要优化脚本的输出?

现在它只是输出工作表A的第一列,加上相关的差异字段/单元格。

如果有相同的预期错误重复,我会想象一个累积和总计,以使意外错误更加明显。

非常感谢您提出任何建议:

    'Look for the [] and replace
    'So [User] = yourusername
    'And [Worksheetname] = yourworksheetname 
    ' etc

    Option Compare Text

    Sub CompareWorkbooks()

    Dim varSheetA As Variant
    Dim varSheetB As Variant
    Dim strRangeToCheck As String
    Dim iRow As Long
    Dim iCol As Long

    nlin = 1
    ncol = 1

    'Get the worksheets from the workbooks
    Set wbkA = Workbooks.Open(Filename:="C:\Users\[User]\[Path]\[Workbookname].xlsm") ' or whatever workbook path
    Set varSheetA = wbkA.Worksheets("[WorksheetName]") ' or whatever sheet you need

    Set wbkB = Workbooks.Open(Filename:="C:\Users\[User]\[Path]\[Workbookname].xlsm")
    Set varSheetB = wbkB.Worksheets("Sheet1") ' or whatever sheet you need

    Set wbkC = Workbooks.Open(Filename:="C:\Users\[User]\[Path]\[Workbookname].xlsm")

    strRangeToCheck = "A2:BX2000" ' If you know the data will only be in a smaller range, reduce the size of the ranges above.
    Debug.Print Now
    varSheetA = wbkA.Worksheets("[WorksheetName]").Range(strRangeToCheck)
    varSheetB = wbkB.Worksheets("[WorksheetName]").Range(strRangeToCheck) ' or whatever your other sheet is.
    Debug.Print Now

    For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1)
        For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2)
            If varSheetA(iRow, iCol) = varSheetB(iRow, iCol) Then
        ' Cells are identical.
        ' Do nothing.
    Else
       ' Cells are different. Let's fill our main template with the information
        Workbooks("New.xlsm").Activate
        Cells(nlin, ncol) = varSheetA(iRow, 1) 'Gives the AID of the related changed field
        Cells(nlin, ncol + 1) = varSheetA(iRow, iCol) 'Gives me the value in workbookA
        Cells(nlin, ncol + 2) = varSheetB(iRow, iCol) 'Gives me the value in workbookB
        nlin = nlin + 1
            End If
        Next
    Next

    End Sub

0 个答案:

没有答案