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

Question

我有一个名为Mainsheet的主表以及12个其他表，每个月一个。

我Mainsheet一月或二月或三月，等的几个月里，我需要复制的数据可能有数据反映在我的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一个月？我怎样才能指定Jan的月份，而不是像我的代码中的某个特定日期，例如1/20/2017？

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

Answer 1

干得好！你已经编写了代码来处理一个月份表！

现在采取这一大块，将其复制 - 但不是下粘贴与"Feb"更换"Jan"等等...... 12倍....做到这一点：

Private Sub UpdateMonthlyData(ByVal target As Worksheet) 

End Sub 

然后将其粘贴在那里，并用target代替Sheets("Jan")。你留下了这一点：

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带来了代码浏览器），和然后打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# - 这对字符串文字。通过使用#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操作仍然没有做你想做的事 - 但唉，这个答案已经够长了！祝你好运！