VBA代码效率跟踪更改

Question

我的下面的代码很好用问题我的范围是现在扩展，我需要更强大的高效方式接近它。

当更新以下范围并保存文件时，代码会更新我的日期工作表表（两个条件都需要满足）。有什么建议吗？

Sheet3.Range D（20,24,25,27,28,30,31,32,33,34,35,37,38,40,42,43,44,54,55,56,58， 59,61,62,63,64,65）

Sheet3.Range E（20,24,25,27,28,30,31,32,33,34,35,37,38,40,42,43,44,54,55,56,58， 59,61,62,63,64,65）

'set as public variables to remain saved while workbook is open
Public val1, val2, val3, val4, Val5

Private Sub Workbook_Open()
'set the variables when the workbook is opened
Call SetValues
End Sub

Private Sub SetValues()
'save the values to be checked later
val1 = Sheets("Sheet3").Range("D20").Value
val2 = Sheets("Sheet3").Range("D24").Value
val3 = Sheets("Sheet3").Range("D25").Value
val4 = Sheets("Sheet3").Range("D27").Value
Val5 = Sheets("Sheet3").Range("D28").Value
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet, wsDates As Worksheet
Dim endRow As Long, updateRow As Long, x As Long
Dim checkDate

Set ws = ThisWorkbook.Sheets("Sheet3")
Set wsDates = ThisWorkbook.Sheets("Dates")

'if the values have been changed
If _
val1 <> ws.Range("D20").Value Or _
val2 <> ws.Range("D24").Value Or _
val3 <> ws.Range("D25").Value Or _
val4 <> ws.Range("D27").Value Or _
Val5 <> ws.Range("D28").Value Then

    'reset the values to avoid multiple updates
    Call SetValues

    'set the range of values to check
    endRow = wsDates.Cells(wsDates.Rows.Count, 1).End(xlUp).Row

    'check to see if an entry was found the same week
    For x = 1 To endRow
        checkDate = wsDates.Cells(x, 2).Value
        If checkDate >= (Date - Weekday(Date, vbSunday) + 1) And checkDate <= (Date - Weekday(Date, vbSaturday) + 1 + 7) Then
            updateRow = x
            Exit For
        End If
    Next x

    'if an entry the same week wasn't found, set update row to new row
    If updateRow = 0 Then updateRow = endRow + 1

    'update or add information
    wsDates.Cells(updateRow, 1).Formula = Application.UserName
    wsDates.Cells(updateRow, 2).Formula = Format(Now, "mm/dd/yyyy")
    wsDates.Cells(updateRow, 3).Formula = Format(Now, "HH:mm:ss")


End If

End Sub