删除相似的行

我有90000行3个单词的列表。 我需要删除每一行，如果任何其他行包含2个相同的单词。 例如

Word1 word2 word3 word1 word2 word4 - delete word1 word2 word5 - delete word1 word6 word7 - keep, only 1 matching words compared to earlier rows 

有没有办法做到这一点？

Answer 1

步骤1.使用文本到列或公式将单词分为三列（A，B和C）

步骤2.在D，E和F列中，通过以下公式创build所有双字组合：

 =A1&B1 =B1&C1 =A1&C1 

第3步。将下面的公式放在G1中，并通过列H和I以及所有行进行填充：

 =SUM(COUNTIF(OFFSET($D$1,0,0,ROW(D1),1),D1),COUNTIF(OFFSET($E$1,0,0,ROW(E1),1),D1),COUNTIF(OFFSET($F$1,0,0,ROW(F1),1),D1))-COUNTIF($D1:$F1,D1) 

电子表格现在应该看起来像这个截图（除了我添加到最后的两行之外）：

具有与上面一行中的两个词匹配的两个词的所有行在G，H或I列中将具有大于0的值。

第4步。最后，按行G，H和I过滤整个表，等于0.如果需要，您可以复制并（通过值）将单词过滤到另一个表。

Answer 2

这三个词组是在不同的单元格中，还是都在同一个单元格中。

如果他们在单独的单元格中，则可以使用此macros：

 Option Explicit Sub DeleteDups() Dim colPhrase As Collection Dim colRows As Collection Dim V As Variant, vRes() As Variant Dim I As Long, J As Long Dim lDupCount As Long Dim rRes As Range 'results range V = Worksheets("sheet1").Range("a1", Cells(Rows.Count, "C").End(xlUp)) Set colPhrase = New Collection Set colRows = New Collection Set rRes = Range("e1") 'look for dups For I = 1 To UBound(V) lDupCount = 0 On Error Resume Next For J = 1 To 3 colPhrase.Add Item:=CStr(V(I, J)), Key:=CStr(V(I, J)) If Err.Number <> 0 Then lDupCount = lDupCount + 1 Err.Clear Next J On Error GoTo 0 If lDupCount < 2 Then colRows.Add Item:=CStr(I) Next I ReDim vRes(1 To colRows.Count, 1 To 3) For I = 1 To colRows.Count For J = 1 To 3 vRes(I, J) = V(colRows(I), J) Next J Next I Set rRes = rRes.Resize(UBound(vRes), 3) rRes.EntireColumn.Clear rRes = vRes End Sub 

如果它们在同一个单元格中，根据短语的分隔方式，您只需要添加一行将它们分隔成三个数组元素。