Vba 选择并复制到最后一行数据的有效方法_Vba_Excel

Vba 选择并复制到最后一行数据的有效方法

vba excel

Vba 选择并复制到最后一行数据的有效方法,vba,excel,Vba,Excel,上下文我在Excel中建立了一个模型，允许用户通过从支付系统下载来加载预算和支付数据。用户可以加载成本中心预算（在I_预算表中）调整预算，按save，然后将数据转储到“SavedData”表中。然后，他们可以将另一个成本中心载入I_预算但是，如果用户出错或希望在SavedData中修改其先前编辑的预算，他们可以单击I_Budget中的“加载”，数据将被复制到其他位置 VBA代码从SavedData加载用户预算的代码： Public Sub LoadUsersSavedBudgets()

上下文
我在Excel中建立了一个模型，允许用户通过从支付系统下载来加载预算和支付数据。用户可以加载成本中心预算（在I_预算表中）调整预算，按save，然后将数据转储到“SavedData”表中。然后，他们可以将另一个成本中心载入I_预算

但是，如果用户出错或希望在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

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

将用户预算保存到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

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表中的最后一行，因为我们可能会不断地向其中添加数据。

找到最后一行的编号应该是这样的（这不是很短，只是简单了一点）：

在您的情况下，这将产生与

sht.Cells.Find

相同的结果，因为您以前访问过

UsedRange

。但是，

Find

操作应该传递最后一个非空行，即使您之前没有访问

UsedRange

，其中

SpecialCells

解决方案可能返回一个实际上更大的行号，因为用户在那里填充了一些值，删除了值，并且以前没有保存文档

此外，我将避免调用sub来选择一个范围，然后由下一个函数通过

Application.Selection

获取该范围。最好将

DynamicColumnSelector

设置为一个函数，返回桩中的

范围

：

 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

是的。

查找最后一行的编号应该是这样的（这不是很短，只是简单了一点）：