VBA根据数据值将数据从主表复制并粘贴到另一个表中

Question

我有一个名为Mainsheet 的主工作表和另外 12 个工作表，每个月一个。

我的Mainsheet 可能有 1 月或 2 月或 3 月等月份的数据。我需要复制我的mainsheet 中反映的数据并将其粘贴到Jan 或Feb 之一，具体取决于哪个一个月了。

这是我目前所拥有的......

Sub Macro1()

    Dim i, LastRow
    LastRow = Sheets("Mainsheet").Range("A" & Rows.Count).End(xlUp).Row

    For i = 5 To LastRow

        If Sheets("Mainsheet").Cells(i, "E").Value = "1/20/2017" Then
            Sheets("Mainsheet").Cells(i, "A").EntireRow.Copy 
            Destination:=Sheets("Jan").Range("A" & Rows.Count).End(xlUp).Offset(1)
        End If

    Next i

End Sub

我的问题是，如果数据是 Feb 而不是 Jan 月份，我该如何继续宏？以及如何在我的代码中仅指定一月而不是特定日期，例如 2017 年 1 月 20 日？

另外，我怎样才能只复制从A5:M5 到最后一个填充单元格的行，而不是从A:5 复制整个范围直到使用的最后一列？

Answer 1

干得好！您已经编写了处理一个月表的代码！

现在取出该块，复制它 - 但不要将其粘贴到下面并将 "Jan" 替换为 "Feb" 等等...... 12 次......这样做：

Private Sub UpdateMonthlyData(ByVal target As Worksheet)

End Sub

然后将其粘贴到那里，并将Sheets("Jan") 替换为target。你只剩下这个了：

Private Sub UpdateMonthlyData(ByVal target As Worksheet)
    Dim i, LastRow
    LastRow = Sheets("Mainsheet").Range("A" & Rows.Count).End(xlUp).Row
    For i = 5 To LastRow
        If Sheets("Mainsheet").Cells(i, "E").Value = "1/20/2017" Then
            Sheets("Mainsheet").Cells(i, "A").EntireRow.Copy 
            Destination:=target.Range("A" & target.Rows.Count).End(xlUp).Offset(1)
        End If    
    Next i
End Sub

让我们稍微清理一下 - 在 Project Explorer 中双击 Mainsheet (Sheet1) 对象（Ctrl+R - 使用 Rubberduck 调出 Code Explorer )，然后按 F4 以调出其属性。将(Name) 属性从Sheet1 更改为MainSheet。现在你可以这样做了：

Private Sub UpdateMonthlyData(ByVal target As Worksheet)
    With MainSheet

        Dim lastRow As Long
        lastRow = .Range("A" & .Rows.Count).End(xlUp).Row

        Dim i As Long
        For i = 5 To lastRow
            If .Cells(i, "E").Value = #1/20/2017# Then
                .Cells(i, "A").EntireRow.Copy target.Range("A" & target.Rows.Count).End(xlUp).Offset(1)
            End If
        Next

    End With
End Sub

MainSheet 是一个“免费”全局范围对象变量，您可以通过将其 (Name) 属性设置为 MainSheet 来获得 - VBA 创建一个以它命名的全局范围对象，您可以在代码中的任何地方使用它来参考那个表。

那么我们在这里得到了什么？我们得到一个monthSheet 参数，这是我们要复制到的工作表：弄清楚这是它自己的另一个问题，我们不需要为此烦恼。我将声明移到更靠近它们的使用位置，并为声明指定了显式类型，With MainSheet 指令限定了所有使用点 . 和 该工作表 对象的内容。

合格的东西很重要：当它前面没有明确的工作表引用时，Range、Cells、Rows、Columns、...它们都隐含地引用了ActiveSheet - 当你'正在使用任何 非活动工作表的工作表，然后隐式调用活动工作表意味着麻烦。

我将 #date literal# 括在 # 中，而不是 " - 这是 string 文字。通过使用#date literal#，您可以避免从String 到Date 的隐式转换，因为.Cells(i, "E").Value 应该是Variant/Date。

接下来我们参数化月份并推断工作表：

Private Sub UpdateMonthlyData(ByVal monthIndex As Long)
    With MainSheet

        On Error GoTo ErrHandler

        Dim name As String
        name = MonthName(monthIndex, True)

        Dim target As Worksheet
        target = ThisWorkbook.Worksheets(name)

        On Error GoTo 0 'from this point onward any error bubbles up to the caller

        Dim lastRow As Long
        lastRow = .Range("A" & .Rows.Count).End(xlUp).Row

        Dim i As Long
        For i = 5 To lastRow
            Dim monthCell As Range
            monthCell = .Cells(i, "E")
            If Not IsError(monthCell.Value) Then
                If CStr(monthCell.Value) = name Then
                    .Cells(i, "A").EntireRow.Copy target.Range("A" & target.Rows.Count).End(xlUp).Offset(1)
                End If
            Else
                Debug.Print "Cell " & monthCell.Address & " contains an error value and cannot be processed."
            End If
        Next

    End With
    Exit Sub

ErrHandler:
    Debug.Print "Could not find a worksheet for month " & monthIndex & "."
End Sub

现在调用者只需要运行一个从 1 到 12 的循环来处理所有工作表：

For i = 1 To 12
    UpdateMonthlyData i
Next

它并没有比我想象的更干净:)

现在，.Copy 操作仍然无法执行您希望它执行的操作 - 但唉，这个答案已经够长了！祝你好运！