尝试创建搜索/复制/粘贴 VBA 代码 [英] Trying to create a search/copy/paste VBA code

问题描述

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

I am new to VBA and I'm trying to automate a reporting function on a spreadsheet which requires manual work that could be avoided. I have created the below code but I keep on receiving error messages. I will explain what I am trying to achieve and hopefully we will find a solution to this issue.

我有两张工作表，我想查看 Sheet1 的 L 列以及所有值为NO"的单元格，我想复制同一行 A 列中的值，并将其粘贴到最后A 列中 Sheet2 的行.

I have two sheets, and I want to look into column L of Sheet1 and for all cells that has "NO" for value, I want to copy the value in column A of the same row, and paste it in the last row of Sheet2 in the column A.

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

Sounds pretty simple but I cannot get my head around the code.

下面的代码有什么问题?

What is wrong with the below code?

    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

推荐答案

您可以使用 FIND.这将找到 NO 但不会找到 No 或 nO(更改为 MatchCase=False 以查找所有案例).

You could use FIND. This will find NO but not No or nO (change to MatchCase=False to find all cases).

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等

I've added an explanation of your code below - the main thing wrong with your code is ActiveCell.Range("A").Copy. There is no range A, but there is A1,A2, etc.

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

这篇关于尝试创建搜索/复制/粘贴 VBA 代码的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！