重複するテキスト値の削除（Microsoft Excel）

=IF(A2=A1,"Duplicate","")

Sub CreateUniqueList()

Dim rData As Range     Dim rTemp As Range

Set rData = Range(Range("a1"), Range("A65536").End(xlUp))

rData.EntireColumn.Insert     Set rTemp = rData.Offset(0, -1)

rData.AdvancedFilter _         Action:=xlFilterCopy, _         CopyToRange:=rTemp, _         Unique:=True

rTemp.EntireColumn.Copy _         rData.EntireColumn     Application.CutCopyMode = False     rTemp.EntireColumn.Delete     Set rData = Nothing     Set rTemp = Nothing End Sub

Sub DelDups()

Dim rngSrc As Range     Dim NumRows As Integer     Dim ThisRow As Integer     Dim ThatRow As Integer     Dim ThisCol As Integer     Dim J As Integer, K As Integer

Application.ScreenUpdating = False     Set rngSrc = ActiveSheet.Range(ActiveWindow.Selection.Address)



NumRows = rngSrc.Rows.Count     ThisRow = rngSrc.Row     ThatRow = ThisRow + NumRows - 1     ThisCol = rngSrc.Column

'Start wiping out duplicates     For J = ThisRow To (ThatRow - 1)

If Cells(J, ThisCol) > "" Then             For K = (J + 1) To ThatRow                 If Cells(J, ThisCol) = Cells(K, ThisCol) Then                     Cells(K, ThisCol) = ""

End If             Next K         End If     Next J

'Remove cells that are empty     For J = ThatRow To ThisRow Step -1         If Cells(J, ThisCol) = "" Then             Cells(J, ThisCol).Delete xlShiftUp         End If     Next J     Application.ScreenUpdating = True End Sub