vba - VBA中的复制功能

Question

非常感谢您的支持。我看到错误在哪里了。

我想知道是否可以将输入框也做成下拉框？

<小时/>

这段代码似乎没有复制到“Sheet2”

我有这个数据集

但是当我检查“Sheet2”时，它是空白的。我错过了什么？

非常感谢您的建议

`子SearchForString()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Dim LSearchValue As String

On Error GoTo Err_Execute

LSearchValue = InputBox("Please enter a value to search for.", "Enter value")

'Start search in row 4
LSearchRow = 4

'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2

While Len(Range("A" & CStr(LSearchRow)).Value) > 0

    'If value in column E = LSearchValue, copy entire row to Sheet2
    If Range("E" & CStr(LSearchRow)).Value = LSearchValue Then

        'Select row in Sheet1 to copy
        Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
        Selection.Copy

        'Paste row into Sheet2 in next row
        Sheets("Sheet2").Select
        Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
        ActiveSheet.Paste

        'Move counter to next row
        LCopyToRow = LCopyToRow + 1

        'Go back to Sheet1 to continue searching
        Sheets("Sheet1").Select

    End If

    LSearchRow = LSearchRow + 1

Wend

'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select

MsgBox "All matching data has been copied."

Exit Sub

执行错误: MsgBox“发生错误。”

结束子`

Answer 1

您可以像 Vityata 所说的那样，简单地保留您实际要查找的单元格，而不是使用 Select。

所有的选择都会减慢你的速度。

而不是:

Sheets("Sheet2").Select
Range("A5").Select
ActiveCell.Copy

你可以简单地做

Sheets("Sheet2").Range("A5").Copy

如果您要经常引用某个工作表，您也可以考虑使用 With 语句。

With 语句让您可以省略字符串的部分内容。

所以你可以简单地说:

With Sheets("Sheet1")
    .Cells(1,1) = "Hi"    'Same as Sheets("Sheet1").Cells(1,1)
    .Cells(1,2) = "Hello" 'Same as Sheets("Sheet1").Cells(1,2)
End With

仅提供几点建议 - 如果您有任何疑问，请告诉我。

这是您的简化代码。

Sub SearchForString()
Dim c, LSearchValue, LSearchRow, LCopyToRow, LastRow
On Error GoTo ErrHandle
LSearchValue = InputBox("Please enter a value to search for.", "Enter value")
LastRow = Sheets("Sheet1").Cells(Rows.CountLarge, "D").End(xlUp).Row
LSearchRow = 4
LCopyToRow = 2
For Each c In Sheets("Sheet1").Range("D" & LSearchRow & ":D" & LastRow)
    If c = LSearchValue Then
        c.EntireRow.Copy Sheets("Sheet2").Cells(LCopyToRow, "A")
        LCopyToRow = LCopyToRow + 1
    End If
Next c
Application.CutCopyMode = False
MsgBox "All matching data has been copied."
Exit Sub
ErrHandle: MsgBox "An Error Has Occured: " & Err.Description
End Sub

Sheet1 输入:

Sheet2 输出: