嘗試創建搜索/復制/粘貼VBA代碼

Question

我是VBA的新手，我正在嘗試自動執行電子表格中的報告功能，而這需要避免手工操作。 我已經創建了以下代碼，但是我繼續收到錯誤消息。 我將解釋我要實現的目標，並希望我們能夠找到解決該問題的方法。

我有兩張紙，我想查看工作表Sheet1的L列，對於所有值為“ NO”的單元格，我想將值復制到同一行的列A中，並將其粘貼到工作表Sheet2的最后一行在A欄中。

聽起來很簡單，但是我無法理解代碼。

以下代碼有什么問題？

    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/.. period！ 這是一個很糟糕的vba-excel做法，可以隨時避免。 另外，僅因為您通過RowCount循環並不意味着該單元處於活動狀態。 這也可能是您不斷收到錯誤的原因：MSDN定義下的Application.ActiveCell如下：

   返回一個Range對象，該對象表示活動窗口 （頂部窗口）或指定窗口中的活動單元格 。 如果窗口未顯示工作表，則此屬性將失敗 。 只讀。

   （有關如何避免使用它們的更多信息，請參考此 stackoverflow問題）

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” （更改為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