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

Posted 2023-05-01

1.如果H列中，从上至下第1个数是4，第二个数大于等于5以上，第三个数小于等于4，那么就复制相领三列，即FGH列复制粘贴到A工作表中2.如果L列中，从上至下第1个数是4，第二和第三个数大于等于5以上，第四个数小于等于4，那么就复制相领三列，即JKL列复制粘贴到B工作表中3.如果P列中，从上至下第1个数是4,第二三四这三个数大于等于5以上，第五个数小于等于4,那么就复制相领三列，即NOP列复制粘贴到C工作表中4..如果T列中，从上至下第1个数是4,第二三四五这四个数大于等于5以上,第六个数小于等于4，那么就复制相领三列，即RST列复制粘贴到D工作表中5.如果X列中，从上至下第1个数是4,第二三四五六这五个数大于等于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工作表。

以下是可以实现上述条件的示例代码：
Sub CopyData()
Dim i As Integer, j As Integer, lastRow As Integer, targetSheet As Worksheet
javaCopy codelastRow = Cells(Rows.Count, "H").End(xlUp).RowFor i = 1 To lastRow
If Cells(i, 8).Value = 4 Then
If Cells(i + 1, 8).Value >= 5 And Cells(i + 2, 8).Value <= 4 Then Set targetSheet = Worksheets("A")
targetSheet.Range("F" & targetSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1 & ":H" & targetSheet.Cells(Rows.Count, "A").End(xlUp).Row + 2).Value = Range("F" & i & ":H" & i + 2).Value
End If
End If
Next ilastRow = Cells(Rows.Count, "L").End(xlUp).RowFor i = 1 To lastRow
If Cells(i, 12).Value = 4 Then
If Cells(i + 1, 12).Value >= 5 And Cells(i + 2, 12).Value >= 5 And Cells(i + 3, 12).Value <= 4 Then Set targetSheet = Worksheets("B")
targetSheet.Range("J" & targetSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1 & ":L" & targetSheet.Cells(Rows.Count, "B").End(xlUp).Row + 3).Value = Range("J" & i & ":L" & i + 3).Value
End If
End If
Next ilastRow = Cells(Rows.Count, "P").End(xlUp).RowFor i = 1 To lastRow
If Cells(i, 16).Value = 4 Then
If Cells(i + 1, 16).Value >= 5 And Cells(i + 2, 16).Value >= 5 And Cells(i + 3, 16).Value >= 5 And Cells(i + 4, 16).Value <= 4 Then Set targetSheet = Worksheets("C")
targetSheet.Range("N" & targetSheet.Cells(Rows.Count, "C").End(xlUp).Row + 1 & ":P" & targetSheet.Cells(Rows.Count, "C").End(xlUp).Row + 4).Value = Range("N" & i & ":P" & i + 4).Value
End If
End If
Next ilastRow = Cells(Rows.Count, "T").End(xlUp).RowFor i = 1 To lastRow
If Cells(i, 20).Value = 4 Then
If Cells(i + 1, 20).Value >= 5 And Cells(i + 2, 20).Value >= 5 And Cells(i + 3, 20).Value >= 5 And Cells(i + 4, 20).Value >= 5 And Cells(i + 5, 20).Value <= 4 Then Set targetSheet = Worksheets("D")
targetSheet追问

提示出错了

参考技术A 楼上不想真心回答的就别答了。我看懂你的意思了，如果第一个数是4，第2个数大于5，第23个大于5，第234大于5，以此类推。这里边肯定要用到循环函数初始i=1,然后每循环一次i+1。
我这里有个疑问，如果L列第一个数不是4，或者L列第2个第3个数不大于5，那就是不复制粘贴，接下来P列是选按照23大于5,4小于等于4执行还是，234大于5,5小于等于4执行。 参考技术B 复制粘贴数据符合规定的从一个工作表到另一个使用VBA,您可以使用一个循环语句来遍历Excel文件和一个if语句中的数据来确定它是否符合标准。然后,您可以使用复制和粘贴的方法将数据从一个工作表到另一个地方。例如,您可以使用VLOOKUP函数搜索表中的值。您还可以使用索引或匹配功能。或者,您可以编写一个宏,它使用一个if语句检查特定的细胞值,然后将整个行包含这些值到另一个工作表。 参考技术C 首先，您需要定义筛选条件，然后根据这些条件来筛选数据。接下来，您需要创建一个For Next循环，以确定是否符合所定义的条件。一旦确定符合条件的数据，您就可以使用Range.Copy方法来将它复制到相应的工作表中。最后，您可以使用Range.PasteSpecial命令来将数据粘贴到目标工作表。 参考技术D 被粘贴的工作表没描述，需补充。追问

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

如何用index函数把数据库中给定一个时间段内符合给出的一些条件的所有行数据提取到另一个工作表中？

如图中红色部分是给出的一个时间段区域，绿色部分是下拉列表可以选择为条件的区域，请问公式应该如何写才能实现，谢谢各位老师！请帮帮忙，谢谢！

你这个数据，这么多条件， 如果用公式写也不是不可以但是需要数组公式，会非常麻烦。数组公式运算量也会很大，所以会导致运算非常缓慢。
建议用VBA来解决，可以实现你的问题，VBA运算也比较快，统计更准确。
当然，写VBA代码需要你的原表样表。如果让我写不免费。有必要的话可私信。 以下可以说一下思路。
如果用公式，要计算每一列的数据是否符合条件，如果符合所有组合条件，则返回行号，如果不符合所有条件，则返回工作表最大行号。然后用small或者large+row函数将对应符合条件的行号根据序列提取出来，然后再用index或者indirect函数返回相应的数据。由于你要查询的数据量比较大，每个单元格都要把数组中的数据运算一遍，再提取相应的数据，所以运算量非常大。可能会卡的受不了。
用VBA的思路，核对每一行数据，如果符合条件的，写入数组或者字典，然后将数组或者字典中的数据输出即可。所以每一行的数据只用提取一遍，而且内存运算， 速度非常快。 当然，如果不习惯这个， 也可以用复制粘贴的方法， 符合条件的直接粘贴过来也行。这样数据量大的话，可能会慢一些，但是可以带格式，代码相对好写一些，比较直观。
不管用哪种方式，做现在你这个要求的工作，都是代码比较合适。
如果还有问题，欢迎继续追问或者私信。 参考技术A 把问题作为内容（邮件主题一定要包含“excel”,本人以此为依据辨别非垃圾邮件，以免误删）,excel样表文件（尽量详细说明现状和目标效果）作为附件发到1流3油箱：yqch134帮你看下本回答被提问者采纳