尝试创建搜索/复制/粘贴 VBA 代码

Question

我是 VBA 新手，我正在尝试自动化电子表格上的报告功能，这需要可以避免的手动工作。我创建了以下代码，但我不断收到错误消息。我将解释我正在努力实现的目标，并希望我们能找到解决此问题的方法。

我有两张纸，我想查看 Sheet1 的 L 列，对于所有值为“NO”的单元格，我想复制同一行的 A 列中的值，并将其粘贴到最后A列中Sheet2的行。

听起来很简单，但我无法理解代码。

下面的代码有什么问题？

    Sub SearchMacro()

    Dim wb As Workbook
    Dim ws As Worksheet
    Set wb = ActiveWorkbook
    Set ws = Sheets("Sheet1")
    wb.Activate
    ws.Select

RowCount = Cells(Cells.Rows.Count, "A").End(xlUp).Row
For i = 1 To RowCount
    Range("L" & i).Select
    If ActiveCell = "NO" Then
        ActiveCell.Range("A").Copy
        Sheets("Sheet2").Select
        RowCount = Cells(Cells.Rows.Count, "A").End(xlUp).Row
        Range("A" & RowCount + 1).Select
        ActiveSheet.Paste
        Sheets("Sheet1").Select
    End If
Next

End Sub

Answer 1

我认为您可以使用自动过滤器而不是循环。

RowCount = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Cells.AutoFilter ' set an filter on the sheet
With Sheets("Sheet1").Range("A1:L" & RowCount) ' filter on NO column L
    .AutoFilter Field:=12, Criteria1:="NO"
End With
Sheets("Sheet1").Range("A2:L" & Range("A2").End(xlDown)).Copy 'Copy the filtered data
Sheets("Sheet2").Select
RowCount = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Range("A" & RowCount + 1).Select
ActiveSheet.Paste

Answer 2

我有点想将此问题标记为重复问题，因为每天都有大量此类复制粘贴数据问题，但是哦，好吧..

1. 不要使用Select/ActiveCell/Activesheet/Activeworkbook/.. 句号！！ 这是一个不好的vba-excel 做法，总是可以避免的。此外，仅仅因为您通过 RowCount 循环并不意味着该单元格处于活动状态。这可能也是你不断报错的原因：Application.ActiveCell在MSDN下定义如下：

   返回一个 Range 对象，表示活动单元格中的活动单元格 window（顶部的窗口）或在指定的窗口中。 如果窗口 未显示工作表，此属性失败。只读。

   （有关如何避免使用这些的更多信息，请参阅thisstackoverflow 问题）

2. 您的代码中有一些小错误。我没有您正在使用的数据，也没有关于哪个工作表的信息，所以我将假设 Sheet1 包含您要复制的数据，而 Sheet2 包含您要粘贴的数据

   Private Sub copy_paste()
   
   Dim ws_source As Worksheet: Set ws_source = Sheets("Sheet1")
   Dim ws_target As Worksheet: Set ws_target = Sheets("Sheet2")
   
   Dim last_row As Long
   last_row = ws_source.Cells(ws_source.Rows.Count, "L").End(xlUp).Row
   Dim next_paste As Long
   
   For i = 1 To last_row
       If ws_source.Cells(i, "L") = "NO" Then
           ws_source.Rows(i).EntireRow.Copy
           next_paste = ws_target.Cells(ws_target.Rows.Count, "A").End(xlUp).Row + 1
           ws_target.Rows(next_paste).PasteSpecial xlPasteValues
       End If
   Next i
   
   End Sub
   

有数据：

预期结果：

Answer 3

您可以使用FIND。这将找到 NO 但不是 No 或 nO（更改为 MatchCase=False 以查找所有案例）。

Public Sub SearchAndCopy()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim last_row As Long
    Dim rFound As Range
    Dim sFirstAdd As String

    Set wb = ThisWorkbook 'ActiveWorkbook
                          'Workbooks("SomeWorkbook.xlsx")
                          'Workbooks.Open("SomePath/SomeWorkbook.xlsx")

    Set ws = wb.Worksheets("Sheet1")
    Set ws1 = wb.Worksheets("Sheet2")

    With ws.Columns("L")
        Set rFound = .Find(What:="NO", _
                           LookIn:=xlValues, _
                           LookAt:=xlWhole, _
                           SearchDirection:=xlNext, _
                           MatchCase:=True)

        If Not rFound Is Nothing Then
            sFirstAdd = rFound.Address
            Do
                'Find next empty row on destination sheet.
                    'Only really need to give worksheet reference when
                    'counting rows if you have 2003 & 2007+ files open - "ws.Rows.Count"
                last_row = ws1.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1

                'Copy the figure from source to target sheet.
                'You could also use Copy/Paste if you want the formatting as well.
                ws1.Cells(last_row, 1) = ws.Cells(rFound.Row, 1)

                'Look for the next matching value in column L.
                Set rFound = .FindNext(rFound)
            Loop While rFound.Address <> sFirstAdd
        End If
    End With

End Sub  

我在下面添加了对您的代码的解释 - 您的代码的主要错误是ActiveCell.Range("A").Copy。没有范围A，但是有A1、A2等。

Sub SearchMacro()

    'You didn't declare these two which
    'indicates you haven't got Option Explicit
    'at the top of your module.
    Dim RowCount As Long
    Dim i As Long

    Dim wb As Workbook
    Dim ws As Worksheet

    'I'll only comment that you set
    'wb to be the ActiveWorkbook and you then
    'activate the active workbook which is already active.....
    Set wb = ActiveWorkbook
    Set ws = Sheets("Sheet1")
    wb.Activate
    ws.Select

    'Looks at the active sheet as you just activated it.
    'Generally better to say "the cells in this named worksheet, even if it isn't active, or
    'in the active book... just reference the damn thing."
    'Something like "ws.cells(ws.cells.rows.count,"A").End(xlUp).Row"
    'Note it references the correct worksheet each time.
    RowCount = Cells(Cells.Rows.Count, "A").End(xlUp).Row
    For i = 1 To RowCount
        Range("L" & i).Select
        If ActiveCell = "NO" Then

            'Your code falls over here - you can't have range A.
            'You can have range A1, which is the first cell in your referenced range.
            'So ActiveCell.Range("A1") will return the ActiveCell - "L1" probably.
            ActiveCell.Range("A1").Copy

            'This will copy from column A using your method:
            'ws.Cells(ActiveCell.Row, 1).Copy

            'If you get the above line correct this will all work.
            Sheets("Sheet2").Select
            RowCount = Cells(Cells.Rows.Count, "A").End(xlUp).Row
            Range("A" & RowCount + 1).Select
            ActiveSheet.Paste

            'You've already called it "ws" so just "ws.Select" will work.
            Sheets("Sheet1").Select
        End If
    Next

End Sub