我有大量数据,第3列包含电子邮件地址。我正在尝试根据我具有的意思的邮件列表复制行,只要该行包含邮件列表中的一封电子邮件,它将被复制并粘贴到新的工作表中。目前,我有一个代码可以复制所需的数据,但一次只能基于一封电子邮件。我有一个用户表单,最多可以设置几个电子邮件地址,以作弊,但这仍然没有效果。这是我的代码,一次使用一个电子邮件地址。
Private Sub CommandButton1_Click()
a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("Sheet1").Cells(i, 3).Value = "bperez <[email protected]>" Then
Worksheets("Sheet1").Rows(i).Copy
Worksheets("Sheet2").Activate
b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Sheet2").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Sheet2").Activate
End If
Next
Application.CutCopyMode = False
End Sub
非常感谢您提供有关如何基于多封电子邮件复制行的任何输入。
将您的所有电子邮件地址加载到HashSet中:
Dim h as New HashSet(Of String)
h.Add("bperez <[email protected]>")
h.Add("bperez2 <[email protected]>")
并更改您的代码,例如:
If h.Contains(Worksheets("Sheet1").Cells(i, 3).Value) Then