以下是我作为POC创建的代码,用于实现2个excel文件比较(逐个单元格)
这只是为了测试逻辑,它按预期工作,但我发现对于大数据(数百行和列),使用excel对象的这种方法非常耗时。比较130行和248列所需的大约时间约为10分钟。
有什么方法可以优化这个
注意:“代码处于基本级别”只接受优化
Dim a()
Dim b()
x = 0
file1 = InputBox("Enter the first file")
file2 = InputBox("enter the second file")
'create FSO and check if the file exist
Set fso = CreateObject("Scripting.FileSystemObject")
if (fso.fileExists(file1)) and (fso.fileExists(file2)) then
MsgBox "The file exists"
Else
MsgBox "The file doesn't exists"
ErrCount = 1
End if
if Errcount <> 1 then
'Create excel object for both the files and compare
Set objExcel = CreateObject("Excel.Application")
'Iterate from worksheets for both the file
Set objFile1 = objExcel.Workbooks.Open(file1)
objFile1Count = objFile1.Worksheets.count
Set objFile2 = objExcel.Workbooks.Open(file2)
objFile2Count = objFile2.Worksheets.count
End if
'sheet should be same
if objFile1Count <> objFile2Count then
ErrCount = 1
End if
' Loop through the sheets
if ErrCount <> 1 then
For cnt = 1 to objFile1.Sheets.count
Set file1Sheet = objFile1.Sheets(cnt)
Set file2Sheet = objFile2.Sheets(cnt)
'Check the sheet name
if file1Sheet.Name <> file2Sheet.Name then
ErrCount = 1
Exit For
Else
'File 1
file1RC = file1Sheet.usedrange.rows.count
file1CC = file1Sheet.usedrange.columns.count
'File 2
file2RC = file2Sheet.usedrange.columns.count
file2CC = file2Sheet.usedrange.columns.count
'Iterate file
For i = 2 to file1RC
For j = 1 to file1CC
ReDim Preserve a(x)
ReDim Preserve b(x)
a(x) = Trim(file1Sheet.Rows(i).columns(j).value)
b(x) = Trim(file2Sheet.Rows(i).columns(j).value)
file2getRC = i &"," &j
file1getRC = i &"," &j
'Check compare and add color
File1Val = a(x)
File2Val = b(x)
if File1Val = File2Val then
'do nothing as the values matches
Else
RNC = split(file1getRC, ",")
Col = RNC(1)
Row = RNC(0)
Col = CInt(Col)
ty = file1Sheet.Rows(Row).Cells(1, Col).value
file1Sheet.Rows(Row).Cells(1, Col).Interior.ColorIndex = 6
file2Sheet.Rows(Row).Cells(1, Col).Interior.ColorIndex = 6
objFile1.Save
objFile2.Save
End if
x=x+1
Next
Next
End if
Next
MsgBox "it works"
Else
MsgBox "No file added or cancelled"
End if