我目前有一个脚本(从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