选择并复制到最后一行数据

时间:2015-09-26 09:09:01

标签: excel vba excel-vba

上下文
我在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表格中的最后一行,因为我们可能会不断向其中添加数据。

1 个答案:

答案 0 :(得分:0)

找到最后一行的编号应该是这样的(这不是很短,只是稍微简单一些):

    sht.Cells.SpecialCells(xlCellTypeLastCell).Row 

在您的情况下,这应该产生与sht.Cells.Find相同的结果,因为您之前访问过UsedRange。但是,Find操作应该提供最后一个非空行,即使您之前没有访问UsedRangeSpecialCells解决方案可能会返回实际上更大的行号,因为用户填写了那里有一些值,删除了值并且之前没有保存文档。

此外,我会避免调用一个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

做到了。