我有一个带有几张纸的excel文件.在一张“Daily Tracker”页面上,我在页面上有一些数据,在我的代码中,我将此范围标记为“DailyTable”,其中包含我想要复制的数据.
一旦数据完全填满一周,我想要做几件事.
>’DailyTable’中的数据被复制到最后一行数据下的’Daily Backup’. [我有这个工作]
>在复制’DailyTable’之前,它会检查重复数据[防止多次按下备份宏并重复数据.]
>如果数据重复,则会发出通知,告知用户他们已经支持本周的数据.
>我将有一个清除数据的另一个脚本,在一周内向上打勾#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
最佳答案 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
而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