Question

到目前为止，这并不复杂，但是我只是excel宏的新手。我已经在网上找到并对其进行了编辑以供使用，但我知道它已经很长了。单个范围都引用同一单元格，而该单元格只是=today()的值。我知道可以集成，但我不知道如何。其余的将复制一行并将其粘贴到特定行的底部，每位雇员一个。我确定还有更好的方法，因为要复制的行仅在此代码中存在，并且不是主要数据源。但是一次只一步。哈哈

Sub LastRowDtDataTEST()
Dim wb As Workbook
Dim ws As Worksheet
Dim LastRow As Long
Set wb = ActiveWorkbook
Set ws = ThisWorkbook.Sheets("Buyer Trend Metrics")
ws.Select

Range("B58").Copy  ' Copies the value of =Today() from a cell. Would be easier to just integrate today's date instead.
LastRow = Cells(Rows.Count, "J").End(xlUp).Row
Range("J" & LastRow + 1).PasteSpecial Paste:=xlPasteValues

Range("B61:H61").Copy
LastRow = Cells(Rows.Count, "K").End(xlUp).Row ' get last row with data in column "K"
Range("K" & LastRow + 1).PasteSpecial Paste:=xlPasteValues ' paste values

Range("B58").Copy  ' Copies the value of =Today() from a cell. Would be easier to just integrate today's date instead.
LastRow = Cells(Rows.Count, "S").End(xlUp).Row
Range("S" & LastRow + 1).PasteSpecial Paste:=xlPasteValues

Range("B62:H62").Copy
LastRow = Cells(Rows.Count, "T").End(xlUp).Row
Range("T" & LastRow + 1).PasteSpecial Paste:=xlPasteValues

Range("B58").Copy  ' Copies the value of =Today() from a cell. Would be easier to just integrate today's date instead.
LastRow = Cells(Rows.Count, "AB").End(xlUp).Row
Range("AB" & LastRow + 1).PasteSpecial Paste:=xlPasteValues

Range("B63:H63").Copy
LastRow = Cells(Rows.Count, "AC").End(xlUp).Row
Range("AC" & LastRow + 1).PasteSpecial Paste:=xlPasteValues

Range("B58").Copy  ' Copies the value of =Today() from a cell. Would be easier to just integrate today's date instead.
LastRow = Cells(Rows.Count, "AK").End(xlUp).Row
Range("AK" & LastRow + 1).PasteSpecial Paste:=xlPasteValues

Range("B64:H64").Copy
LastRow = Cells(Rows.Count, "AL").End(xlUp).Row
Range("AL" & LastRow + 1).PasteSpecial Paste:=xlPasteValues

Range("B58").Copy  ' Copies the value of =Today() from a cell. Would be easier to just integrate today's date instead.
LastRow = Cells(Rows.Count, "AT").End(xlUp).Row
Range("AT" & LastRow + 1).PasteSpecial Paste:=xlPasteValues

Range("B65:H65").Copy
LastRow = Cells(Rows.Count, "AU").End(xlUp).Row
Range("AU" & LastRow + 1).PasteSpecial Paste:=xlPasteValues

Range("B58").Copy  ' Copies the value of =Today() from a cell. Would be easier to just integrate today's date instead.
LastRow = Cells(Rows.Count, "BC").End(xlUp).Row
Range("BC" & LastRow + 1).PasteSpecial Paste:=xlPasteValues

Range("B66:H66").Copy
LastRow = Cells(Rows.Count, "BD").End(xlUp).Row
Range("BD" & LastRow + 1).PasteSpecial Paste:=xlPasteValues

Range("B58").Copy  ' Copies the value of =Today() from a cell. Would be easier to just integrate today's date instead.
LastRow = Cells(Rows.Count, "BL").End(xlUp).Row
Range("BL" & LastRow + 1).PasteSpecial Paste:=xlPasteValues

Range("B67:H67").Copy
LastRow = Cells(Rows.Count, "BM").End(xlUp).Row
Range("BM" & LastRow + 1).PasteSpecial Paste:=xlPasteValues

Range("B58").Copy  ' Copies the value of =Today() from a cell. Would be easier to just integrate today's date instead.
LastRow = Cells(Rows.Count, "BU").End(xlUp).Row
Range("BU" & LastRow + 1).PasteSpecial Paste:=xlPasteValues

Range("B68:H68").Copy
LastRow = Cells(Rows.Count, "BV").End(xlUp).Row
Range("BV" & LastRow + 1).PasteSpecial Paste:=xlPasteValues

Range("B58").Copy  ' Copies the value of =Today() from a cell. Would be easier to just integrate today's date instead.
LastRow = Cells(Rows.Count, "CD").End(xlUp).Row
Range("CD" & LastRow + 1).PasteSpecial Paste:=xlPasteValues

Range("B69:H69").Copy
LastRow = Cells(Rows.Count, "CE").End(xlUp).Row
Range("CE" & LastRow + 1).PasteSpecial Paste:=xlPasteValues

Range("B58").Copy  ' Copies the value of =Today() from a cell. Would be easier to just integrate today's date instead.
LastRow = Cells(Rows.Count, "CM").End(xlUp).Row
Range("CM" & LastRow + 1).PasteSpecial Paste:=xlPasteValues

Range("B70:H70").Copy
LastRow = Cells(Rows.Count, "CN").End(xlUp).Row
Range("CN" & LastRow + 1).PasteSpecial Paste:=xlPasteValues

End Sub

Answer 1

以下是您要看的东西...

始终使用Option Explicit。有关说明，请参见here。
在执行复制数据之类的操作时，非常清楚地定义数据的源和目标非常有帮助。这包括定义数据将到达哪个Workbook。您稍后会感谢我现在养成这种习惯。

例如：

Dim srcWB As Workbook
Dim dstWB As Workbook
Set srcWB = ThisWorkbook
Set dstWB = ThisWorkbook

Dim srcWS As Worksheet
Dim dstWS As Worksheet
Set srcWS = srcWB.Sheets("Sheet1") ' <--- you didn't specify this in your code
Set dstWS = dstWB.Sheets("Buyer Trend Metrics")

当您一遍又一遍地执行相同（或非常相似）的动作时，最好创建一个单独的函数来为您执行动作。当您破坏这段代码时，它称为“功能隔离”。这意味着，如果您要解决问题，则只需将其解决在一个位置，而不必在代码中查找所有可完成相同工作的地方。

在您的情况下，您正在执行从一个单元格区域到另一个单元格区域的复制。因此，将其分解为一个单独的例程看起来像这样：

Private Sub CopyMyData(ByRef fromData As Range, ByRef toData As Range)
    Dim lastrow As Long
    With toData.Parent
        lastrow = .Cells(.Rows.Count, toData.Column).End(xlUp).Row
    End With

    fromData.Copy
    toData.Cells(lastrow).PasteSpecial Paste:=xlPasteValues
End Sub

在此注意我如何使用变量名来描述代码的作用（fromData和toData）。这样可以清楚地了解正在发生的事情。

将它们放在一起，您的代码将如下所示：

Option Explicit

Public Sub StartCopying()
    Dim srcWB As Workbook
    Dim dstWB As Workbook
    Set srcWB = ThisWorkbook
    Set dstWB = ThisWorkbook

    Dim srcWS As Worksheet
    Dim dstWS As Worksheet
    Set srcWS = srcWB.Sheets("Sheet1") ' <--- you didn't specify this in your code
    Set dstWS = dstWB.Sheets("Buyer Trend Metrics")

    CopyMyData fromData:=srcWS.Range("B58"), toData:=dstWS.Range("J:J")

    CopyMyData fromData:=srcWS.Range("B61:H61"), toData:=dstWS.Range("K:K")

    CopyMyData fromData:=srcWS.Range("B58"), toData:=dstWS.Range("S:S")

    CopyMyData fromData:=srcWS.Range("B61:H62"), toData:=dstWS.Range("T:T")
End Sub

Private Sub CopyMyData(ByRef fromData As Range, ByRef toData As Range)
    Dim lastrow As Long
    With toData.Parent
        lastrow = .Cells(.Rows.Count, toData.Column).End(xlUp).Row
    End With

    fromData.Copy
    toData.Cells(lastrow).PasteSpecial Paste:=xlPasteValues
End Sub

Answer 2

请勿将每行加倍。您应该将它们用作战略分隔符，而不是标准分隔符。 这不是MLA。
使用工作表变量快速引用您的表（ScrollView指具有要复制单元格的表，ws（目标表）指要在其中单元格的表粘贴
您也可以使用值转移代替不需要多行的复制/粘贴

通常，在缩短代码时，您要寻找重复性。我可以看到您一直在复制ds中的值，因此也可以缩短它。您有评论说您希望今天的价值不变，所以您可以做类似的事情

Range("B58") 根据需要重复

ds.Range("?") = Today

Answer 3

有一种复制/粘贴方式。

复制每一行，粘贴到第10列之后的第9列。

我添加了两行用于查找最后一行-查找一次并将所有内容粘贴到该行，然后在每次复制之前将其查找。取消注释，无论您喜欢哪个。

这会将B61:H61复制到最后一行的K:P（日期在J中），然后将B62:H62复制到T:Z，日期在{{ 1}}。

日期还将以正确的格式显示，而不是数字。

需要帮助缩短此Excel 2013宏

3 个答案: