删除重复，但荣誉案件

我需要删除重复的数据，如：

我使用如下代码：

Sub Macro1() ActiveSheet.Range("$G$1:$G$10").RemoveDuplicates Columns:=1, Header:=xlNo End Sub 

这产生：

我想保留具有相同字母顺序但不同情况的单词。 我将如何实现这一目标？

Answer 1

你可以使用下面的代码。 假设数据在A1到A7的范围内，对于不同的范围可以修改代码。

 Dim oDic As Object, vData As Variant, r As Long Set oDic = CreateObject("Scripting.Dictionary") With Range("A1:A7") vData = .Value .ClearContents End With With oDic .comparemode = 0 For r = 1 To UBound(vData, 1) If Not IsEmpty(vData(r, 1)) And Not .Exists(vData(r, 1)) Then .Add vData(r, 1), Nothing End If Next r Range("A1").Resize(.Count) = Application.Transpose(.keys) End With 

Answer 2

这里有一个方法可以为你工作。 （它显然有一些粗糙的编码元素，但我认为你得到的图片，可以修复任何需要的）：

 Sub RespectCase() Dim rSearch As Range, cel As Range, rFound As Range Set rSearch = Range("G1:G10") Set rFound = Range("J1:J10") For Each cel In rSearch Dim rMatch As Range Set rMatch = rFound.Find(cel, LookAt:=xlWhole, MatchCase:=True) If rMatch Is Nothing Then Range("J10").End(xlUp).Offset(1).Value = cel End If Next End Sub