如何使用vba从excel中的2列中删除重复值答案

【问题标题】：How to remove duplicate values from 2 columns in excel using vba如何使用vba从excel中的2列中删除重复值
【发布时间】：2011-12-09 14:02:13
【问题描述】：

我是 Excel VBA 编程的新手。我有一个包含两列的 excel 表，每列都有一些电子邮件地址，由@@ 分隔。喜欢
ColumA
aa@yahoo.com@@bb@yahoo.com@@cc@yahoo.com
x@.com@@y@y.com

B 列
zz@yahoo.com@@aa@yahoo.com
aa@yahoo.com

如您所见，两列都有两行，我需要第三列应该包含所有唯一值，例如
ColumnCtrong>
aa@yahoo.com@@bb@yahoo.com@@cc@yahoo.com@zz@yahoo.com
x@.com@@y@y.com@@aa@yahoo.com

谢谢

【问题讨论】：

你用的是什么版本的excel？
我假设你在 ColumnC 中打错字了，在 zz@yahoo.com 之前应该有两个 @@，而不是一个。
是的。那是真的..它的打字错误:(

标签： vba find duplicate-removal

【解决方案1】：

这样的变量数组和字典是获得所需结果的有效过程

[更新删除字符串前面的分隔符，代码在分隔符长度上是灵活的] SO似乎已经删除了上传图片的功能，所以我的图片掉了....

Sub GetUniques()
Dim strDelim As String
Dim X
Dim Y
Dim objDic As Object
Dim lngRow As Long
Dim lngRow2 As Long
strDelim = "@@"
Set objDic = CreateObject("scripting.dictionary")
X = Range([a1], Cells(Rows.Count, "B").End(xlUp)).Value2
For lngRow = 1 To UBound(X, 1)
    X(lngRow, 1) = X(lngRow, 1) & strDelim & X(lngRow, 2)
    Y = Split(X(lngRow, 1), strDelim)
    X(lngRow, 1) = vbNullString
    For lngRow2 = 0 To UBound(Y, 1)
        If Not objDic.exists(lngRow & Y(lngRow2)) Then
            X(lngRow, 1) = X(lngRow, 1) & (strDelim & Y(lngRow2))
            objDic.Add (lngRow & Y(lngRow2)), 1
        End If
    Next lngRow2
    If Len(X(lngRow, 1)) > Len(strDelim) Then X(lngRow, 1) = Right(X(lngRow, 1), Len(X(lngRow, 1)) - Len(strDelim))
Next lngRow
[c1].Resize(UBound(X, 1), 1).Value2 = X
End Sub

【讨论】：

如果我可以提供任何建议，那就是将 strDelim 声明为字符串。现在它是一个变体（在这种情况下 objDic 也是一个变体和对象）。
是的，现在 strDelim 暗淡是一个疏忽
感谢您的及时关闭:)

【解决方案2】：

这是我的看法。它是如何工作的：

将 A 列和 B 列转储到变体数组中
合并每一行，分成一组电子邮件，然后用字典清除重复项。
将唯一列表组合成一个字符串并存储在一个新数组中
将新数组转置到 C 列。

Sub JoinAndUnique()

Application.ScreenUpdating = False
Dim varray As Variant, newArray As Variant
Dim i As Long, lastRow As Long
Dim temp As Variant, email As Variant
Dim newString As String, seperator As String
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")

seperator = "@@"
lastRow = range("A" & Rows.count).End(xlUp).Row
varray = range("A1:B" & lastRow).Value
ReDim newArray(1 To UBound(varray, 1))

On Error Resume Next
For i = 1 To UBound(varray, 1)
    temp = Split(varray(i, 1) & seperator & varray(i, 2), seperator)
    For Each email In temp
        If Not dict.exists(email) Then
            dict.Add email, 1
            newString = newString & (seperator & email)
        End If
    Next
    newArray(i) = Mid$(newString, 3)
    dict.RemoveAll
    newString = vbNullString
Next

range("C1").Resize(UBound(newArray)).Value = Application.Transpose(newArray)
Application.ScreenUpdating = True

End Sub

注意：它与 brettdj 的回答非常相似，但有一些不同之处值得一提：

我为变量使用了更有意义的名称（为了便于阅读和更容易编辑）
我确实清理了句子开头的“@@”
我使用新数组而不是覆盖现有数组的值
我选择在每个单元格后清除字典
我选择使用“on error resume next”，只是将条目转储到字典中，而不是检查它们是否存在（个人喜好，没有太大区别）

【讨论】：

Issun，我很困惑你会发布这个，因为它与我的代码几乎完全相同，但有一些外观（而不是关键）差异。但是在您更改的部分 (1) 使用 Str 和 Lng 等更常见于为变量名称添加前缀Hungarian Notation (2) 此注释作为调整有意义 (3) 该数组仅为代码创建，因此它可能为很好地被操纵 - 它不“存在”这样（4）我不需要添加额外的步骤（尤其是在循环内）清理字典，因为我附加了每个唯一的行号
请不要误解 - 我发布一个类似的解决方案没有恶意。我想通过添加解释和使用差异来为 OP 提供一个更容易理解的解决方案。变量名。 Hungarion Notation 是一种偏好，我不喜欢使用它，因为 VBA 代码的范围非常小，而且 IMO 的可读性较差。使用 dict 没问题 - 我只是展示了一个不同的解决方案（做一个 concat 将行号添加到每个条目对我来说有点难以理解）。再一次，没有难过的感觉，这个网站的美妙之处在于每个人都有差异。采取。
我对 Issun 没有难过的感觉，也不打算以这种方式阅读我的评论。我认为我应该逐步了解您的 cmets，以便任何读者清楚我为什么按照我的方式运行我的代码，因为我认为“关键”差异部分暗示我做出了一些次优选择而不是样式格式。我完全同意每个程序员都有自己的风格和偏好。非问题，干杯:)
干杯 :) “关键差异”的意思是“性格差异”，也就是值得指出的变化（不是更好）。 ^^

【解决方案3】：

最简单的方法是使用dictionary object、split function 和join function。当然，你不需要使用那些确切的，但试一试，看看你会得到什么。

【讨论】：