Excel VBA – 复制前检查范围内的数据是否已经存在

我有一个excel文件，几张。 在一张“Daily Tracker”上，我在页面上有一些数据，在我的代码中，我将这个范围标记为“DailyTable”，其中包含我想要复制的数据。

一旦数据完全填充一周，我想有几件事情发生。

1. “DailyTable”中的数据复制到最后一行数据下的“每日备份”中。 [我有这个工作]
2. 在“DailyTable”被复制之前，它会检查重复数据[防止多次按下备份macros，并且重复数据。]
3. 如果数据是重复的，通知让用户知道他们已经支持了这个星期的数据。
4. 我将有另外一个脚本来清除数据，将＃号加1。当我之前testing这个过程时，你会看到一些inputvariables。 如果有更好的方法来做这件事，就会喜欢听到的想法。

我的第一个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没有使用，所以我评论他们。

我已经添加了一些以显示它可以是多么有用（它会提高性能）。

而且，当你可以，使用Excel内置的function将更有效率（如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 

---

有几个改变，select覆盖或不（我结合两个潜艇）：

  '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 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