上下文
我在Excel中构建了一个模型,允许用户从付费系统下载加载预算和支付数据。用户可以加载成本中心预算(在I_Budget表中)进行调整,按保存并将数据转储到“已保存的数据”表中。然后,他们可以将另一个成本中心加载到I_Budget。
但是,如果用户犯了错误或希望修改他们之前在SavedData中编辑的预算,他们可以点击I_Budget中的“加载”,数据将被复制。
VBA代码
从SavedData加载用户预算的代码:
Public Sub LoadUsersSavedBudgets()
Const WORKSHEET_DATA = "SavedData"
Const WORKSHEET_BUDGET = "I_Budget"
Const START_CELL = "A2"
Const END_COLUMN = "H"
' Check if the user can perform the load action
If IsEmpty(Sheets(WORKSHEET_DATA).Range("A2").Value) Then Exit Sub
Worksheets(WORKSHEET_BUDGET).Unprotect
' A fudge to make Excel copy the data in the sheet
Worksheets(WORKSHEET_DATA).Visible = True
' Select all rows in the selection
Call DynamicColumnSelector(WORKSHEET_DATA, START_CELL, END_COLUMN)
' Set the range of the selected cells
Set Rng = Application.Selection
' Copy the selection
Rng.Copy
' Now paste the results
With Sheets(WORKSHEET_BUDGET).Range("A18")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
Worksheets(WORKSHEET_BUDGET).Protect
' Clear the data in I_Budget to give the user a blank canvas
Call DeleteUsersSavedBudgets
Worksheets(WORKSHEET_DATA).Visible = False
Application.ScreenUpdating = True
Sheets(WORKSHEET_BUDGET).Select
MsgBox "Success! Your budgets have been loaded."
End Sub
将用户预算保存到SavedData的代码:
Public Sub SaveUsersBudgetAdjustments()
Const WORKSHEET_BUDGET = "I_Budget"
Const START_CELL = "A18"
Const END_COLUMN = "H"
Const WORKSHEET_OUTPUT = "SavedData"
Const FILTER_COST_CENTRE = "I_Setup!I16"
Dim nRng As Range
' Protect user from running this method if no data has been laoded
If IsEmpty(Range("I_Budget!H18").Value) = True Then Exit Sub
' Issue warning to user
If MsgBox("Would you like so save your changes into the O_Budget sheet?" & vbNewLine & vbNewLine & "You can always load them again for editing.", vbYesNo) = vbNo Then Exit Sub
Application.ScreenUpdating = False
' We make sure the budget adjustments have been taken into account before any saving begins
Call UpdateRevisedBudget
Worksheets(WORKSHEET_BUDGET).Unprotect
' Select all rows in the selection
Call DynamicColumnSelector(WORKSHEET_BUDGET, START_CELL, END_COLUMN)
' Set the range of the selected cells
Set Rng = Application.Selection
' Delete the destination contents
'Sheets(WORKSHEET_OUTPUT).Rows("2:" & Rows.Count).Clear
' Copy and paste the selection into the destination sheet
Rng.Copy
' A fudge to allow the copying and pasting of data to work
If IsEmpty(Sheets(WORKSHEET_OUTPUT).Range("A2").Value) Then
With Sheets(WORKSHEET_OUTPUT).Range("A2")
.PasteSpecial xlPasteValues
End With
Else
With Sheets(WORKSHEET_OUTPUT).Range("A1").End(xlDown).Rows.Offset(1, 0)
.PasteSpecial xlPasteValues
End With
End If
' and clear the selection contents
Selection.ClearContents
Worksheets(WORKSHEET_BUDGET).Protect
Application.ScreenUpdating = True
End Sub
最感兴趣的可能是我调用动态选择数据到最后一行的方法:
Private Sub DynamicColumnSelector(shtValue, StartCellValue, StartColumnValue)
'Best used when column length is static
Dim sht As Worksheet
Dim LastRow As Long
Dim StartCell As Range
Set sht = Worksheets(shtValue)
Set StartCell = Range(StartCellValue)
'Refresh UsedRange
Worksheets(shtValue).UsedRange
'Find Last Row
LastRow = sht.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'Select Range
Sheets(shtValue).Select
sht.Range(StartCellValue & ":" & StartColumnValue & LastRow).Select
End Sub
考试问题
我的问题是,虽然上述工作,但它感觉有异味和低效。有没有更好的方法可以在工作表中选择数据并将其复制?我必须考虑SavedData表格中的最后一行,因为我们可能会不断向其中添加数据。
答案 0 :(得分:0)
找到最后一行的编号应该是这样的(这不是很短,只是稍微简单一些):
sht.Cells.SpecialCells(xlCellTypeLastCell).Row
在您的情况下,这应该产生与sht.Cells.Find
相同的结果,因为您之前访问过UsedRange
。但是,Find
操作应该提供最后一个非空行,即使您之前没有访问UsedRange
,SpecialCells
解决方案可能会返回实际上更大的行号,因为用户填写了那里有一些值,删除了值并且之前没有保存文档。
此外,我会避免调用一个sub来选择一个范围,然后由Application.Selection
抓住下一个函数。更好的是,让DynamicColumnSelector
函数返回Range
所涉及的函数:
Function DynamicColumnSelector(...) as Range
' ...
Set DynamicColumnSelector=sht.Range(...)
End Function
并像这样称呼它
Set Rng = DynamicColumnSelector(...)
Rng.Copy
这使您的代码在以后的更改中更加强大。当您必须稍后更改执行顺序或在其间插入一些其他代码时,更改或依赖于全局选择的代码容易出错。更糟糕的是,它更长,更慢并且对用户具有视觉效果。直接传递范围对象的代码没有这些问题。
不幸的是,PasteSpecial
操作只能与剪贴板一起使用,而不能直接用于范围到范围的复制。如果您只想复制值,则不需要PasteSpecial
,但如果您想将格式复制为wll,这可能是最简单,最安全的解决方案。所以我不希望复制/粘贴的解决方案比你自己找到的解决方案简单得多。
正如您所问:只复制没有任何格式的值,没有剪贴板:
Set rng = DynamicColumnSelector(...)
Set destinationRng = Sheets(WORKSHEET_OUTPUT).Range("A2")
rng.Copy destinationRng
做到了。