在VBA中复制功能

Question

非常感谢您的支持。我看到了错误的地方。

我想知道是否可以将输入框作为下拉菜单？

此代码似乎不会复制到＆＃34; Sheet2＆＃34;

我有这个数据集

但是当我检查了我的＆＃34; Sheet2＆＃34;它是空白的。我错过了什么？

非常感谢您的建议

`Sub 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

Err_Execute：     MsgBox＆＃34;发生错误。＆＃34;

结束Sub`

Answer 1

而不是使用Select，你可以简单地保留你正在寻找的单元格，而Vityata说。

所有选择都会让你失望。

而不是：

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输出：

Answer 2

通常，从屏幕截图中，“邮箱”位于D列，您正在检查列E。在列E中写下“邮箱”，它应该可以正常工作。

尽管如此：

问题是您没有引用工作表，因此VBA引用ActiveSheet。例如，而不是：

Range("E" & CStr(LSearchRow)).Value = LSearchValue

你应该写：

Worksheets(2).Range("E" & CStr(LSearchRow)).Value = LSearchValue

或者代替：

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

代码应该是这样的：

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

因此，尝试重写代码，使用相应的Range正确定义Column，Rows，Cell，Worksheet(1)，它应该可以正常工作。一般来说，使用Select和ActiveCell被视为不良做法 - How to avoid using Select in Excel VBA，但这是第一步，当您从录制宏转到VBA写作时。