VBA中的复制函数

非常感谢你的支持。我看到了错误所在

我想知道输入框是否也可以作为下拉框

---

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

我有这个数据集

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

非常感谢你的建议

`子SearchForString（）

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

---

End Sub`

通常，从您的屏幕截图来看，“邮箱”在

D

列中，您正在检查

E

列。在

E

栏中写上“邮箱”，它应该可以工作

---

然而：

问题是您没有引用工作表，因此VBA引用的是

ActiveSheet

。例如，代替：

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

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

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

你应该写：

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

或者代替：

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

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

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

代码应如下所示：

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

---

因此，尝试重写代码，用相应的

工作表（1）

正确定义

范围

，

列

，

行

，

单元格

，它可能会起作用。一般来说，使用

Select

和

ActiveCell

被认为是不好的做法，但这是第一步，当您从录制宏到编写VBA时。

而不是使用

Select

，您可以像Vityta所说的那样，只保留您实际寻找的单元格

所有的选择都会让你慢下来

而不是：

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

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

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

你可以简单地做

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

你也可以考虑使用<>代码> 语句，如果你要大量引用一张表。

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

表1输入：

表2输出：

---

非常感谢您的留言。很明显，我的专栏错了。当我改变它的时候；然后它成功了。但不知何故，我不得不更新代码。我有点被“请输入一个值”卡住了，可能会有一个下拉列表。像组合框一样？当然-删除输入框行并将

LSearchValue=

设置为要检查的单元格值（例如：

LSearchValue=Sheets（“Sheet1”）.Range（“A1”）

）。然后，只需使用数据验证或其他方法从某个范围创建一个下拉列表。非常感谢您的更正和帮助。我想添加一个下拉框，上面写着请输入一个值。可能吗？