Question

尽管阅读了几个线程来搜索类似问题的答案，但我一直无法自行调试我的代码。

我正在尝试编写一个宏，它将在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

感谢您的帮助！

Answer 1

您的问题出在j循环中：

For J = 0 To UBound(strArray)

数组Ubound的UpperBound（strArray）为0.这是一个包含单个元素"Aeronautic"的数组。

所以你的循环循环一次并退出。

请尝试循环播放您的范围：

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对象的range方法而不是第二个For循环。（根据您的需要使用两者是不必要的）。

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

VBA基于范围内的值将整行复制到新工作表

1 个答案: