Excel VBA根据范围内的值将整行复制到新图纸

尽管读了好几篇文章，寻找类似问题的答案，但我还是无法自己调试代码

我正在尝试编写一个宏，它将在AE和BF之间的所有单元格中搜索术语“航空工程师”，然后将包含该术语的所有行复制到新的工作表中。整张共有99289张

我已尝试使用以下代码，但没有任何运气：

Sub MoveAero()
Dim strArray As Variant
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim NoRows As Long
Dim DestNoRows As Long
Dim I As Long
Dim J As Integer
Dim rngCells As Range
Dim rngFind As Range
Dim Found As Boolean

strArray = Array("Aeronautic")

Set wsSource = ActiveSheet

NoRows = wsSource.Range("A65536").End(xlUp).Row
DestNoRows = 1
Set wsDest = ActiveWorkbook.Worksheets.Add

For I = 1 To NoRows

    Set rngCells = wsSource.Range("AE" & I & ":BF" & I)
    Found = False
    For J = 0 To UBound(strArray)
        Found = Found Or Not (rngCells.Find(strArray(J)) Is Nothing)
    Next J

    If Found Then
        rngCells.EntireRow.Copy wsDest.Range("A" & DestNoRows)

        DestNoRows = DestNoRows + 1
    End If
Next I
End Sub

---

谢谢你的帮助

您的问题在

j

循环中：

For J = 0 To UBound(strArray)

数组

strArray

的上限（

Ubound

）为0。它是一个带有单个元素的数组

“aeronatic”

所以你的循环是循环一次然后退出

相反，尝试在您的范围内循环：

For Each rngCell in rngCells.Cells
    if rngCell.value = "Aeronatic" Then 
        Found = True
        Exit For
    End if
Next rngCell

在这里，我们逐个单元循环遍历刚才创建的

rngCells

范围。然后我们测试单元格是否具有您要查找的值。如果找到它，我们将

found

设置为

true

并退出for循环。您不必退出for循环，但是我们找到了我们想要的，因此没有理由不节省一些cpu时间

---

完整的代码，删除了不必要的变量并移动了一点：

Sub MoveAero()
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim NoRows As Long
Dim DestNoRows As Long
Dim I As Long
Dim J As Integer
Dim rngCells As Range
Dim rngCell as Range

Set wsSource = ActiveSheet

NoRows = wsSource.Range("A65536").End(xlUp).Row
DestNoRows = 1
Set wsDest = ActiveWorkbook.Worksheets.Add

For I = 1 To NoRows

    Set rngCells = wsSource.Range("AE" & I & ":BF" & I)

    For Each rngCell in rngCells.Cells
        if rngCell.value = "Aeronatic" Then 
            'Moved this logic up from the IF block below
            rngCells.EntireRow.Copy wsDest.Range("A" & DestNoRows)
            DestNoRows = DestNoRows + 1
            Exit For
        End if
    Next rngCell

Next I
End Sub

或者，您可以使用

.find

方法来查找

范围

对象，而不是第二个

For

循环。（为了您的需要使用这两种方法是不必要的）

---

将搜索字符串存储到变量，而不是数组。考虑描述“没有运气”的意思。有错误吗？如果是这样，哪一行引发了错误？错误消息是什么？@DavidZemens当我以编写的方式运行宏时，会添加一个新的工作表，但不会复制任何内容。没有错误发生将“For J”之后的所有内容与您选择的内容替换，现在我将获得一个For，没有下一个错误。如果您能重新发布完整的更正代码，我将不胜感激。我试图加入你的建议，似乎把事情搞砸了。谢谢令人惊叹的！非常感谢@jnevil。非常感谢这不是问题。我发布了两个版本。我相信第二个版本会更快，因为它在行/区域上使用

find（）

，而不是在每个单元格中循环。我已经尝试了两个版本，就像您编写它们一样，宏仍然会生成一个空白工作表，而没有所需的复制行。我不知道为什么。当然，我做了一些不正确的事情，但我觉得值得告诉你。我会尝试，并希望找到一个解决方案。再次感谢您的帮助确保您从中复制的工作表在运行此操作时处于“活动”状态，因为其中有

=activeSheet

。确保

航空

的拼写与表格中显示的拼写相同。另外，

aeronatic

是单元格中唯一的内容，还是与其他文本一起出现？

Sub MoveAero()
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim NoRows As Long
Dim DestNoRows As Long
Dim I As Long
Dim rngCells As Range

Set wsSource = ActiveSheet

NoRows = wsSource.Range("A65536").End(xlUp).Row
DestNoRows = 1
Set wsDest = ActiveWorkbook.Worksheets.Add

For I = 1 To NoRows

    Set rngCells = wsSource.Range("AE" & I & ":BF" & I)

    'Try to find your search term in the range
    If Not (rngCells.Find("Aeronautic") Is Nothing) Then
        rngCells.EntireRow.Copy wsDest.Range("A" & DestNoRows)
        DestNoRows = DestNoRows + 1
    End If

Next I
End Sub