Optimize vba code when it comes to processing a hi

2019-08-23 11:17发布

Greeting all! I wrote a code that allows me to compare two EXCEL worksheets for same values; here it is:

Sub compare()

  Dim i As Integer
  Dim j As Integer
  Dim oldVal1 As Variant
  Dim oldVal2 As Variant
  Dim newVal1 As Variant
  Dim newVal2 As Variant
  Dim count As Integer

  Const equal = "equal"

  Dim WKB As Workbook
  Dim OldWS As Worksheet
  Dim NewWS As Worksheet
  Dim DiffWS As Worksheet

  Const OldWSName = "Sheet1"
  Const NewWSName = "Sheet2"
  Const DiffWSName = "Sheet3"

  Set WKB = ActiveWorkbook
  Set OldWS = WKB.Worksheets(OldWSName)
  Set NewWS = WKB.Worksheets(NewWSName)
  Set DiffWS = WKB.Worksheets(DiffWSName)

  Dim OldRow As Long
  Dim NewRow As Long

  Call OptimizeCode_Begin

  oldRow = OldWS.Cells(Rows.Count, 1).End(xlUp).Row
  newRow = NewWS.Cells(Rows.Count, 1).End(xlUp).Row

count = 1

For i = 2 To oldRow
    oldVal1 = OldWS.Cells(i, 1).Value
    oldVal2 = OldWS.Cells(i, 4).Value

    For j = 2 To newRow
        newVal1 = NewWS.Cells(j, 1).Value
        newVal2 = NewWS.Cells(j, 4).Value


        If (oldVal1 = newVal1) And (oldVal2 = newVal2) Then

            count = count + 1
            DiffWS.Cells(count, 1).Value = equal 
            DiffWS.Cells(count, 2).Value = oldVal1 
            DiffWS.Cells(count, 3).Value = oldVal2 
        End If
    Next j
Next i


Call OptimizeCode_End
DiffWS.Activate


'Reset variables

Set WKB = Nothing
Set OldWS = Nothing
Set NewWS = Nothing
Set DiffWS = Nothing

Application.ScreenUpdating = True
MsgBox ("Your data has been compared!")
End Sub

This code is preceded by the variables definitions, long list that I chose not to paste in here. But basically, oldVal1 is the first value compared from OldWS worksheet and oldVal2 the second one from the same worksheet. Those values are being compared with newVal1 and newVal2 from NewWS worksheet (second worksheet). Same values are copied over to DiffWS (third worksheet) with an additional column on the left for the status equal, hence DiffWS.Cells(count + 1, 2).Value = oldVal1.

I've added the following functions to optimize the code and make it run fast when it comes to comparing 2 worksheets of at east 100000 rows:

Sub OptimizeCode_Begin()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

EventState = Application.EnableEvents
Application.EnableEvents = False

PageBreakState = ActiveSheet.DisplayPageBreaks
ActiveSheet.DisplayPageBreaks = False

End Sub

AND

Sub OptimizeCode_End()

ActiveSheet.DisplayPageBreaks = PageBreakState
Application.EnableEvents = EventState
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

The execution is faster on a low number of rows I must admit, but it just doesn't work when the worksheets grow bigger. My EXCEL crashes when I run my code.

Any other optimization tips I should know of? because I am at loss as to how to do this. My code would be useless if no solution is available, and I'd better know it now and think about a way other than EXCEL to compare my data.

Thanks in advance for shedding light on this.

1条回答
闹够了就滚
2楼-- · 2019-08-23 12:00

Your code sample doesn't indicate how you're opening each of the workbooks. In my experience, almost any time Excel crashes, it's because of a memory issue, and often that's because instances of Excel are being opened in the background, and then not .Close'd properly, or perhaps the excel objects not being Set to Nothing (perhaps from repeated execution of the code due to errors).

If this is the case, then Ctrl+Alt+DelTask ManagerProcesses will show multiple instances of Excel, and the easiest fix is to reboot, and then, of course, fix the handling of the Excel object in your code.


If the goal is to compare two worksheets, then perhaps a better question is why you are attempting to re-create functionality that already exists existing solutions available, most likely even built-in to your copy of Office.

Depending on your version, you may already have a utility installed.

compare

For example, if you're running Office Pro Plus 2013, you can use Microsoft Spreadsheet Compare to run a report on the differences.

compare example

More information:


I'm running Excel 2016 from an Office 365 Subscription. I've never had a need to compare spreadsheets, but out of curiosity, I just:

  1. Hit the Windows Key Windows Key

  2. Start typing: spreadsheet compare

start menu

  1. Sit back and let the professionally built analysis/merge tool do it's job.

spreadsheet compare


If all else fails, there are a number of other (3rd-Party) free and paid utilities available as well (such as xlCompare).

xlCompare

查看更多
登录 后发表回答