需要优化excel文件的逐个单元格比较

时间:2017-06-15 12:58:13

标签: excel vbscript

以下是我作为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 

0 个答案:

没有答案
相关问题