如何用VBA判断符合条件的数据复制粘贴到相应工作表？

Posted 2023-05-01

1.如果H列中，从上至下第1个数是3，第二个数大于等于5以上，第三个数小于等于4，那么就复制相领三列，即FGH列复制粘贴到A工作表中2.如果L列中，从上至下第1个数是3，第二和第三个数大于等于5以上，第四个数小于等于4，那么就复制相领三列，即JKL列复制粘贴到B工作表中3.如果P列中，从上至下第1个数是3,第二三四这三个数大于等于5以上，第五个数小于等于4,那么就复制相领三列，即NOP列复制粘贴到C工作表中4..如果T列中，从上至下第1个数是3,第二三四五这四个数大于等于5以上,第六个数小于等于4，那么就复制相领三列，即RST列复制粘贴到D工作表中5.如果X列中，从上至下第1个数是3,第二三四五六这五个数大于等于5以上,,第七个数小于等于4，那么就复制相领三列，即VWX列复制粘贴到E工作表中注意A:依次判断H列，L列,P列，T列，X列，AB列，AF列 ，AJ列..........一直到GV列. B:将符合条件的依次排列复制粘贴到ABCDE工作表中 C:例如FGH列复制粘贴到A工作表。JKL列复制粘贴到B工作表。NOP列复制粘贴到C工作表。即RST列复制粘贴到D工作表。即VWX列复制粘贴到E工作表。

复制粘贴数据符合规定的从一个工作表到另一个使用VBA,您可以使用一个循环语句来遍历Excel文件和一个if语句中的数据来确定它是否符合标准。然后您可以使用VLOOKUP函数搜索表中的值,或者你可以使用索引或匹配函数值在一系列细胞。一旦你已经确定的数据符合你的标准,你可以使用复制和粘贴的方法范围对象的复制粘贴到另一个工作表。或者,您可以使用移动范围对象的方法将整个基于单元格值的行没有删除它们从其原始位置。 参考技术A 刚回答了你的另一个提问。这类vba需要循环套用，如果是某个具体的问题（比如说如何新建sheet，如何vba复制粘贴，如何每计算一次表格往后跳几列）大家都会回答的。如果你把整个需求贴上来，怕是没点money没人回答的。追问

哥们如果可以的话，可以给点红包！

参考技术B A\B\C\D等工作表的已知情况没讲。追问

只要将相符的数据，复制粘贴到对应得工作表就可以了。ABCD等工作表是空白的！

追答

提供文件付费

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

【中文标题】VBA根据数据值将数据从主表复制并粘贴到另一个表中

【英文标题】：VBA Copy and Paste data from mainsheet into another sheet depending on Data value

【发布时间】：2017-04-11 00:43:44

【问题描述】：

我有一个名为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 复制整个范围直到使用的最后一列？

【参考方案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 操作仍然无法执行您希望它执行的操作 - 但唉，这个答案已经够长了！祝你好运！

【讨论】：

Mat's Mug，非常感谢您的时间和解释，一切都很完美！太棒了！

@Tom 很高兴！随意勾选答案旁边的绿色复选标记，就在向上/向下投票按钮的下方:)