如何一次删除多个单元格中的特定文本？

Question

我有大量电子邮件地址列表；但为了简单起见，我要处理在 1 个单元格中输入的 3 - 10 个电子邮件地址，而且我似乎无法大量的删除特定的。有什么方法可以从单元格中删除特定的电子邮件地址吗？已给出我有一份要删除的特定电子邮件地址列表。这是否只是查找重复项并删除的问题，还是还有其他问题？

详细说明：：

在单元格 A2 中我有 [电子邮件保护] [电子邮件保护] [电子邮件保护] [电子邮件保护]

在单元格 A3 中我有 [电子邮件保护] [电子邮件保护] [电子邮件保护] [电子邮件保护]

在单元格 H1 至 H5 中我有[电子邮件保护] [电子邮件保护] [电子邮件保护] [电子邮件保护] [电子邮件保护]（每个电子邮件地址都在单独的单元格中）

有什么办法可以从 A2 和 A3 中删除特定的电子邮件地址，以便只剩下[电子邮件保护]，[电子邮件保护]和[电子邮件保护]？

附加信息：我使用的是 Excel for Mac 2011

任何帮助都将受到高度赞赏。

谢谢你！

Answer 1

回答你的后续问题 -我可以更快地运行这个宏吗？- 我在这里提交我的答案，并投票关闭该问题，因为该问题重复了。

---

如果我理解正确的话，您想取出 H 列中的所有值并将其从 E 列中删除吗？我会使用一些数组来加快速度 -

Option Explicit
Sub DoTheThing()
Application.ScreenUpdating = False
Dim lastrow As Integer
'Find last row in column H to size our array
lastrow = ActiveSheet.Cells(Rows.Count, "H").End(xlUp).row

'Declare the array and then resize it to fit column H
Dim varkeep() As Variant
ReDim varkeep(lastrow - 1)

'Load column H into the array
Dim i As Integer
For i = 0 To lastrow - 1
    varkeep(i) = Range("H" & i + 1)
Next

Dim member As Variant
'find last row in column E
lastrow = ActiveSheet.Cells(Rows.Count, "E").End(xlUp).row

'loop each cell in column E starting in row 2 ending in lastrow
For i = 2 To lastrow
    'Make a new array
    Dim myArray As Variant
    'Load the cell into the array
    myArray = Split(Cells(i, 5), " ")
    Dim k As Integer
    'for each member of this array
    For k = LBound(myArray) To UBound(myArray)
        member = myArray(k)
        'call the contains function to check if the member exists in column H
        If Contains(varkeep, member) Then
            'if it does, set it to nothing
            myArray(k) = vbNullString
        End If
    Next
    'let's reprint the array to the cell before moving on to the next cell in column E
    Cells(i, 5) = Trim(Join(myArray, " "))
Next
Application.ScreenUpdating = True
End Sub


Function Contains(arr As Variant, m As Variant) As Boolean
    Dim tf As Boolean
    'Start as false
    tf = False
    Dim j As Integer
        'Search for the member in the keeparray
        For j = LBound(arr) To UBound(arr)
            If arr(j) = m Then
                'if it's found, TRUE
                tf = True
                Exit For
            End If
        Next j
        'Return the function as true or false for the if statement
        Contains = tf
End Function

这将在 H 列中创建一个数组。然后，它会遍历 E 列中的每个单元格，将其解析为一个数组，根据保留数组搜索该数组的每个成员，如果找到，则删除该数组成员。遍历单元格后，它会重新打印缺少找到的数组。

---

数组通常比逐项执行速度更快，但此外，我们正在创建自己的函数，而不是使用慢的 Find and Replace方法。唯一的问题是数据中可能存在多余的空格。如果是这样，我们可以快速查找并替换它。我发现将数组的成员设置为空比重新调整数组大小并移动元素更容易。

---

为了完整起见，这里有一个从 E 列中删除多余空格的例程

Sub ConsecSpace()
Dim c As Range
Dim lastrow As Integer
lastrow = ActiveSheet.Cells(Rows.Count, "E").End(xlUp).Row
Dim strValue As String
For Each c In Range("E2:E" & lastrow)
    strValue = c.Value
    Do While InStr(1, strValue, "  ")
        strValue = Replace(strValue, "  ", " ")
    Loop
    c = strValue
Next
End Sub

Answer 2

如果我理解错了，你在这里能做的最好的事情就是使用查找和替换

找到您想要的电子邮件，并将其替换为空值。

但这可能会对您的 H 值产生负面影响，但如果您手动查找和替换（一次一个），它应该足够简单和快速。

VBa 解决方案-首先进行备份。

根据您的示例，我假设您的查找从 H1 开始并在某个点结束。

我还假设其他数据从 A2 开始，到 A 中的某行结束

Option Explicit
Sub DoTheThing()
 Dim keepValueCol As String
 keepValueCol = "H"               'You may need to update this

 Dim row As Integer
 row = 2                          'what row do the values start in column A

 Dim keepValueRow As Integer
 keepValueRow = 1

 Do While (Range("A" & row).Value <> "")

    Do While (Range(keepValueCol & keepValueRow).Value <> "")

    Range("A" & row).Value = Replace(Range("A" & row).Value, Range(keepValueCol & keepValueRow).Value, "")
    Range("A" & row).Value = Trim(Replace(Range("A" & row).Value, "  ", " "))

    keepValueRow = keepValueRow + 1
    Loop


 keepValueRow = 1
 row = row + 1
 Loop

End Sub

Answer 3

循环遍历您想要删除的电子邮件列表，只需选择范围并将其替换为空字符串，如下所示：

Sub Replace_Email_List()

Dim rList as Range, rReplace as Range
Dim sEMail as String

'' Following your Example
Set rList = Range("H1",Range("H1").End(xlDown)) '' or just Range("H1:H5")
Set rReplace = Range("A1",Range("A1").End(xlDown)) '' or just Range("A1:A2")

For i = 1 to rList.Row
    sEMail = rList(i,1)

    rReplace.Replace What:=sEmail, Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True
Next i

End Sub

希望我的回答能帮助你