vba - Excel VBA - 在复制之前检查某个范围内的数据是否已存在

Question

我有一个包含几张纸的 Excel 文件。在一张“每日跟踪器”页面上，我在页面上有一些数据，在我的代码中，我将此范围标记为“每日表”，其中包含我要复制的数据。

一旦本周的数据填满，我希望发生几件事。

1. “DailyTable”中的数据已复制到“Daily Backup”最后一行数据下。 [我有这个工作]
2. 在复制“DailyTable”之前，它会检查重复数据[防止多次按备份宏并出现重复数据。]
3. 如果数据重复，则会发出通知，让用户知道他们已经备份了本周的数据。
4. 我将使用另一个脚本来清除数据，将周数增加 1。您会看到此处输入的一些变量，因为我之前测试了此过程。如果有更好的方法，很想听听想法。

我的第一个 VBA 脚本(请指出任何效率低下的地方，或者以不同的方式可能会更好的地方，我非常愿意学习事情如何以及为什么工作):

Sub BackupTable()

     Dim DailyWS As Worksheet
     Dim DailyTable As Range
     Dim BackupWS As Worksheet
     Dim NewTable As Range
     Dim Week As Range
     Dim WeekBackup As Range
     Dim WeekCurrent As String
     Dim WeekNext As String
     Dim NextRow As Long

     Set BackupWS = Worksheets("Daily Backup")
     Set DailyWS = Worksheets("Daily Tracker")
     Set DailyTable = DailyWS.Range("C7:Q21")
     Set Week = DailyWS.Range("F4")
     WeekNext = Week.Value + 1
     NextRow = BackupWS.UsedRange.Rows.Count + ActiveSheet.UsedRange.Rows(1).Row
     Set WeekBackup = BackupWS.Range("A1").Offset(RowOffSet:=NextRow, ColumnOffset:=0)
     Set NewTable = BackupWS.Range("C1:Q15").Offset(RowOffSet:=NextRow, ColumnOffset:=0)

     WeekBackup.Value = Week.Value
     NewTable.Value = DailyTable.Value

     Increases Daily Table Week # by 1.

     Week = WeekNext

End Sub

我确信这看起来很糟糕，但任何帮助将不胜感激。渴望学习。

================================================== ===============================

编辑 2/15:我将其分成两个子例程，因为我想做一个仅备份的问题字符串和一个备份并清除的问题字符串。

Sub ClearDailySheet()
    'Declare the variable ranges.
    Dim tB As Workbook
    Dim DailyWS As Worksheet
    Dim DailyTable As Range
    Dim BackupWS As Worksheet
    Dim NewTable As Range
    Dim Oldtable As Range
    Dim Week As Range
    Dim LastWeek As Range
    Dim WeekBackup As Range
    Dim LastRow As Long
    Dim NextRow As Long

    Set tB = ThisWorkbook
    With tB
        Set BackupWS = .Sheets("Daily Tracker Backup")
        Set DailyWS = .Sheets("Daily Tracker")
    End With 'tB
    With DailyWS
        Set DailyTable = .Range("C7:Q21")
        Set Week = .Range("F4")
    End With 'DailyWS
    With BackupWS
        NextRow = .Range("C" & .Rows.Count).End(xlUp).Row + 1
        Set WeekBackup = .Range("A1").Offset(NextRow, 0)
        Set NewTable = .Range("C1:Q15").Offset(NextRow, 0)
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row - 1
        Set LastWeek = .Range("A1").Offset(LastRow, 0)
        Set Oldtable = .Range("C1:Q15").Offset(LastRow, 0)
    End With 'BackupWS

    If LastWeek.Value <> Week.Value Then
        '''Normal backup
        If vbYes <> MsgBox("Oops! Your daily tracker data for this week has not yet been backed up," & vbCrLf & _
                            "before resetting this form we recommend backing up your data. Proceed with backup? [RECOMMENDED]", vbYesNo + vbQuestion, _
                            "Missing Backup") Then
            '''Avoid backing up now
            MsgBox "It is NOT recommended to reset the daily sheet without backing up this week's data.", vbExclamation + vbOKOnly
            Exit Sub
        Else
            '''Transfer the data
                WeekBackup.Value = Week.Value
                NewTable.Value = DailyTable.Value

                '''Notify User Backup Complete.
                MsgBox "Backup: COMPLETED [Week #" & Week.Value & "]", vbInformation + vbOKOnly

                '''Confirm Clear Data
            If vbNo <> MsgBox("Reset Daily Tracker [Clear Current Data]" & vbCrLf & _
                         "" & vbCrLf & _
                         "Are you SURE you want to reset the daily tracker?" & vbCrLf & _
                         "This canNOT be undone!", _
                         vbYesNo + vbCritical, "Confirm Daily Data Reset") Then

                '''Clear input form
                Clear_InputForm DailyWS

                '''Increases Daily Table Week # by 1 after reset.
                Week.Value = Week.Value + 1

                '''Notify User Backup Complete.
                MsgBox "Backup & Data Reset: COMPLETED!" & vbCrLf & _
                         "" & vbCrLf & _
                         "[Daily Tracker is ready for the new week!]", vbInformation + vbOKOnly
            Else
                '''What to do if they don't want to overwrite?
                MsgBox "Data Reset CANCELLED", vbExclamation + vbOKOnly
                Exit Sub
            End If
        End If
    Else
        '''Data already present
        If vbYes <> MsgBox("This weeks tracker data (week #" & Week.Value & ") appears to be backed up already," & vbCrLf & _
                    "do you want to overwrite the old backup with the latest data before resetting the tracker? [RECOMENDED]", vbYesNo + vbQuestion, _
                    "Backup Data Exists") Then
            '''What to do if they don't want to overwrite?
            MsgBox "Backup & Data Reset: CANCELLED!", vbExclamation + vbOKOnly
        Else
            '''Overwrite backup
            Oldtable.Value = DailyTable.Value

            MsgBox "Backup Overwrite: COMPLETED [Week #" & Week.Value & "]", vbInformation + vbOKOnly

            '''Confirm Clear Data
            If vbNo <> MsgBox("Reset Daily Tracker [Clear Current Data]" & vbCrLf & _
                         "" & vbCrLf & _
                         "Are you SURE you want to reset the daily tracker?" & vbCrLf & _
                         "This canNOT be undone!", _
                         vbYesNo + vbCritical, "Confirm Daily Data Reset") Then

            '''Clear input form
            Clear_InputForm DailyWS

            '''Increases Daily Table Week # by 1 after reset.
            Week.Value = Week.Value + 1

            '''Notify User Backup Complete.
                MsgBox "Backup & Data Reset: COMPLETED!" & vbCrLf & _
                         "" & vbCrLf & _
                         "[Daily Tracker is ready for the new week!]", vbInformation + vbOKOnly

            Else
            '''What to do if they don't want to overwrite?
            MsgBox "Data Reset: CANCELLED!", vbExclamation + vbOKOnly

            End If
        End If
    End If
End Sub

Private Sub Clear_InputForm(SheetToClean As Worksheet)
    '''Actual Range
    SheetToClean.Range("D8:L8,N8,O8,P8,Q8,D13:D19,F13:I19,K13:Q19").Select
    '''Test Range
    'SheetToClean.Range("D31,F31,G31,H31,I31,K31,L31,M31,N31,O31,P31,Q31").ClearContents

End Sub

Sub BackupData()
    'Declare the variable ranges.
    Dim tB As Workbook
    Dim DailyWS As Worksheet
    Dim DailyTable As Range
    Dim BackupWS As Worksheet
    Dim NewTable As Range
    Dim Oldtable As Range
    Dim Week As Range
    Dim LastWeek As Range
    Dim WeekBackup As Range
    Dim LastRow As Long
    Dim NextRow As Long

    Set tB = ThisWorkbook
    With tB
        Set BackupWS = .Sheets("Daily Tracker Backup")
        Set DailyWS = .Sheets("Daily Tracker")
    End With 'tB
    With DailyWS
        Set DailyTable = .Range("C7:Q21")
        Set Week = .Range("F4")
    End With 'DailyWS
    With BackupWS
        NextRow = .Range("C" & .Rows.Count).End(xlUp).Row + 1
        Set WeekBackup = .Range("A1").Offset(NextRow, 0)
        Set NewTable = .Range("C1:Q15").Offset(NextRow, 0)
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row - 1
        Set LastWeek = .Range("A1").Offset(LastRow, 0)
        Set Oldtable = .Range("C1:Q15").Offset(LastRow, 0)
    End With 'BackupWS

    If LastWeek.Value <> Week.Value Then
        '''Normal backup
        If vbYes <> MsgBox("Backing up your daily tracker sheet. You can do this anytime you'd like" & vbCrLf & _
                            "throughout the week. This will simply make a backup of your daily" & vbCrLf & _
                            "data in the 'Daily Tracker Backup' tab. Do you want to proceed?", vbYesNo + vbQuestion, _
                            "Backup Daily Tracker Data") Then
            '''Avoid backing up now
            MsgBox "BACKUP CANCELLED!", vbInformation + vbOKOnly
            Exit Sub
        Else
            '''Transfer the data
                WeekBackup.Value = Week.Value
                NewTable.Value = DailyTable.Value

                '''Notify User Backup Complete.
                MsgBox "BACKUP SUCCESSFUL: Week #" & Week, vbInformation + vbOKOnly
                Exit Sub
            End If
        Else

        '''Data already present
        If vbYes <> MsgBox("This weeks daily data (Week #" & Week.Value & ") is already backedup," & vbCrLf & _
                    "do you want to update this backup [overwrite it]?", vbYesNo + vbQuestion, _
                    "Backup Data Exists") Then
            '''What to do if they don't want to overwrite?
            MsgBox "BACKUP CANCELLED!", vbInformation + vbOKOnly
            Exit Sub
        Else

            '''Overwrite backup
            Oldtable.Value = DailyTable.Value

            MsgBox "BACKUP OVEWRITE SUCCESSFUL: Week #" & Week.Value, vbInformation + vbOKOnly

            End If
        End If

End Sub

Answer 1

WeekNext 没有用，并且 WeekCurrent 没有使用，所以我对它们进行了评论。

我添加了一些With来展示它的有用性(并且它稍微提高了性能)。

如果可以的话，请使用更高效的 Excel 内置函数(例如 RemoveDuplicates)!

Sub BackupTable()
    Dim tB As Workbook
    Dim DailyWS As Worksheet
    Dim DailyTable As Range
    Dim BackupWS As Worksheet
    Dim NewTable As Range
    Dim Week As Range
    Dim WeekBackup As Range
    'Dim WeekCurrent As String
    'Dim WeekNext As String
    Dim NextRow As Long

    Set tB = ThisWorkbook
    With tB
        Set BackupWS = .Sheets("Daily Backup")
        Set DailyWS = .Sheets("Daily Tracker")
    End With 'tB
    With DailyWS
        Set DailyTable = .Range("C7:Q21")
        Set Week = .Range("F4")
    End With 'DailyWS
    With BackupWS
        NextRow = .Range("C" & .Rows.Count).End(xlUp).Row + 1
        Set WeekBackup = .Range("A1").Offset(NextRow, 0)
        Set NewTable = .Range("C1:Q15").Offset(NextRow, 0)
    End With 'BackupWS

    '''Transfer the data
    WeekBackup.Value = Week.Value
    NewTable.Value = DailyTable.Value

    '''Apply RemoveDuplicates (2 parameters):
    '''(the array tells which columns it should take into accout to detect duplicates)
    '''(xlGuess let excel guess if you have Headers, or set it to xlYes or xlNo)
    Call BackupWS.UsedRange.RemoveDuplicates(Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17), xlGuess)

    '''Increases Daily Table Week # by 1.
    Week.Value = Week.Value + 1
End Sub

<小时/>

通过一些更改来选择是否覆盖(我合并了两个子项):

    'Declare the variable ranges.
    Dim tB As Workbook
    Dim DailyWS As Worksheet
    Dim DailyTable As Range
    Dim BackupWS As Worksheet
    Dim NewTable As Range
    Dim Oldtable As Range
    Dim Week As Range
    Dim LastWeek As Range
    Dim WeekBackup As Range
    Dim LastRow As Long
    Dim NextRow As Long

    Set tB = ThisWorkbook
    With tB
        Set BackupWS = .Sheets("Daily Tracker Backup")
        Set DailyWS = .Sheets("Daily Tracker")
    End With 'tB
    With DailyWS
        Set DailyTable = .Range("C7:Q21")
        Set Week = .Range("F4")
    End With 'DailyWS
    With BackupWS
        NextRow = .Range("C" & .Rows.Count).End(xlUp).Row + 1
        Set WeekBackup = .Range("A1").Offset(NextRow, 0)
        Set NewTable = .Range("C1:Q15").Offset(NextRow, 0)
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row - 1
        Set LastWeek = .Range("A1").Offset(LastRow, 0)
        Set Oldtable = .Range("C1:Q15").Offset(LastRow, 0)
    End With 'BackupWS

    If LastWeek.Value <> Week.Value Then
        '''Normal backup
        If vbYes <> MsgBox("Your daily tracker data has not been backed up," & vbCrLf & _
                            "do you want to backup your data up now?", vbYesNo + vbQuestion, _
                            "Missing Backup for this Week") Then
            '''Avoid backing up now
            Exit Sub
        Else
            '''Confirm Clear Data
            If vbNo <> MsgBox("This will reset this section." & vbCrLf & _
                            "Are you SURE you want to reset your daily data sheet?" & vbCrLf & _
                            "This canNOT be undone!", _
                            vbYesNo + vbCritical, "Confirm Daily Data Wipe") Then
                '''Transfer the data
                WeekBackup.Value = Week.Value
                NewTable.Value = DailyTable.Value

                '''Clear input form
                Clear_InputForm DailyWS

                '''Increases Daily Table Week # by 1 after reset.
                Week.Value = Week.Value + 1
                '''Notify User Backup Complete.
                MsgBox "BACKUP COMPLETE: Week #" & Week, vbInformation + vbOKOnly
            Else
                '''What to do if they don't want to overwrite?
                Exit Sub
            End If
        End If
    Else
        '''Data already present
        If vbYes <> MsgBox("This weeks (" & Week.Value & ") daily data appears to be backedup already," & vbCrLf & _
                    "do you want to overwrite the existing backup?", vbYesNo + vbQuestion, _
                    "Backup Data Exists") Then
            '''What to do if they don't want to overwrite?
            Exit Sub
        Else
            '''Overwrite backup
            Oldtable.Value = DailyTable.Value

            '''Clear input form
            Clear_InputForm DailyWS

            MsgBox "BACKUP OVEWRITE COMPLETE: Week #" & Week.Value, vbInformation + vbOKOnly
        End If
    End If
End Sub

以及用于清除表单的子程序(只能从同一模块调用，因为它是私有(private)的):

Private Sub Clear_InputForm(SheetToClean As Worksheet)
    '''Actual Range (avoid using select which is slow)
    'SheetToClean.Range("D8:L8,N8,O8,P8,Q8,D13:D19,F13:I19,K13:Q19").ClearContents
    '''Test Range (use select to see which range you are gonna clear)
    SheetToClean.Range("D31,F31,G31,H31,I31,K31,L31,M31,N31,O31,P31,Q31").Select
    'Selection.ClearContents
End Sub