Question

我正在尝试做一个宏，其中VBA在列中查找特定单词，当它找到单词时，它会将整行从一个工作簿复制到另一个工作簿。它可以找到更多的单词，所以我试图让它循环，虽然它只在for循环中循环ONCE然后停止。

这是for。

Application.Workbooks.Open ("C:\Documents and Settings\1848052\Mis documentos\Portafolios\Vistas\Portafolio.xlsm")
i = 9

For j = 8 To 1000
    celda = Workbooks("Portafolio.xlsm").Sheets("FemCo").Range("B" & j).Value

    If celda = area Then
        Workbooks("Portafolio.xlsm").Sheets("FemCo").Range("B" & j).Select
        fila = ActiveCell.Row

        Windows("Portafolio.xlsm").Activate         ' Copiar row
        Range("A" & fila & ":" & "V" & fila).Select
        Selection.Copy

        Windows("Vista RPAs.xlsm").Activate        'Pegar row
        Range("B" & i & ":W" & i).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False

        i = i + 1
    End If
Next

正如我之前提到的，它只循环一次，然后是：

Workbooks("Portafolio.xlsm").Sheets("FemCo").Range("B" & j).Select

是崩溃的部分，我得到“错误1004”。你觉得我怎么能解决这个错误？

提前致谢。

Answer 1

Simoco第一次得到它，在非活动工作簿中选择。（只是if块）

    Workbooks("Portafolio.xlsm").Sheets("FemCo").Range("A" & fila & ":" & "V" & fila).Copy

    Workbooks("Vista RPAs.xlsm").activesheet.Range("B" & i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False

顺便说一下，整理了一些有效点，但“更好”的方法是在find语句周围运行一个循环，在相关范围内搜索你想要的单词，并在第一个找到的记录时退出再次找到，或者没有找到记录，有很多例子。

Answer 2

您可以改用此代码。它避免使用For j=8 to 1000语句（它使用Find方法 - 当你有很多行时它会好得多）。

Sub test()
   Application.ScreenUpdating = False
   Workbooks.Open ("C:\Documents and Settings\1848052\Mis documentos\Portafolios\Vistas\Portafolio.xlsm")
   i = 9

   With Workbooks("Portafolio.xlsm").Sheets("FemCo")
       Set c = .Range("B8:B1000").Find(area, LookIn:=xlValues)
       If Not c Is Nothing Then
           firstAddress = c.Address
           Do
               Workbooks("Vista RPAs.xlsm").ActiveSheet.Range("B" & i & ":W" & i).Value = _
                .Range("A" & c.Row & ":" & "V" & c.Row).Value
               i = i + 1
               Set c = .Range("B8:B1000").FindNext(c)
           Loop While Not c Is Nothing And c.Address <> firstAddress
       End If
   End With
   Workbooks("Portafolio.xlsm").Close
   Application.ScreenUpdating = True
End Sub

请注意，最好将Workbooks("Vista RPAs.xlsm").ActiveSheet更改为Workbooks("Vista RPAs.xlsm").Sheets("SomeSheetName")

仅循环一次循环并崩溃

2 个答案: