Question

编辑：已实现我问的问题太广泛，所以我更改了要指定的数据。为此道歉。我有这样的样本数据：

J1_D2   J1_D3   J1_D2   J1_D2
J1_D4   J1_D7   J1_D7   
J1_D9   J1_D11  J1_13   J1_14
'
'  
'

我不知道数据的哪一行或哪一行结束。数据将包含Capital Letters和Underscore。数据从D列开始，但我不知道它结束了哪一列。我想删除每行上不同列的重复项，因此它最终会像：

J1_D2   J1_D3    
J1_D4   J1_D7   
J1_D9   J1_D11  J1_13   J1_14 
'
'  
'

更新：我已经尝试了下面给出的答案。它没有正确删除一些数据。我认为这一定是因为数据中的大写字母

Dim r As Range, c As Range
Dim d As Object
Dim ret, i As Long

Set d = CreateObject("Scripting.Dictionary")

On Error Resume Next
Set r = Application.InputBox("Select Range", "Remove Duplicates by Row", , , 
, , , 8)
On Error GoTo 0

If Not r Is Nothing Then
For i = 0 To r.Rows.Count - 1
    For Each c In r.Offset(i).Resize(1)
        'If Not d.Exists(c.Value2) Then d.Add c.Value2, c.Value2 '~> case sensitive
        '/* below is a non-case sensitive comparison */
        If Not d.Exists(UCase(c.Value2)) Then d.Add UCase(c.Value2), c.Value2
    Next
    ret = d.Items()
    r.Offset(i).Resize(1).ClearContents
    r.Offset(i).Resize(1, UBound(ret) + 1) = ret
    d.RemoveAll
Next
End If

Answer 1

您可以尝试这样的事情......

Sub RemoveDuplicates()
Dim lr As Long, lc As Long, i As Long, j As Long
Application.ScreenUpdating = False
lr = ActiveSheet.UsedRange.Rows.Count
For i = 1 To lr
    lc = Cells(i, Columns.Count).End(xlToLeft).Column
    For j = lc To 1 Step -1
        If Application.CountIf(Range(Cells(i, 1), Cells(i, lc)), Cells(i, j)) > 1 Then
            Cells(i, j).Delete shift:=xlToLeft
        End If
    Next j
Next i
Application.ScreenUpdating = True
End Sub

根据您的新样本数据，如果您的数据从D列开始，则需要将代码更改为此...

Sub RemoveDuplicates()
Dim lr As Long, lc As Long, i As Long, j As Long
Application.ScreenUpdating = False
lr = ActiveSheet.UsedRange.Rows.Count
For i = 1 To lr
    lc = Cells(i, Columns.Count).End(xlToLeft).Column
    For j = lc To 4 Step -1
        If Application.CountIf(Range(Cells(i, 1), Cells(i, lc)), Cells(i, j)) > 1 Then
            Cells(i, j).Delete shift:=xlToLeft
        End If
    Next j
Next i
Application.ScreenUpdating = True
End Sub

您可以尝试在此处上传的文件中的代码...

https://www.dropbox.com/s/fqeqqrjieqizc8y/RemoveDuplicates%20v2.xlsm?dl=0

Answer 2

编辑已添加说明。最好的方法是按F8逐步执行每一行。但首先，打开本地窗口，看看变量发生了什么。

试试这个：

var mystring = "one banana apple two carrot bean three threexxx"
var mySplit = mystring.split(/\W(?=one\s|two\s|three\s)/);

console.log(mySplit);

这将允许您选择范围，然后逐行删除所选范围的重复项。

Answer 3

找到第一个和最后一个值范围并使用以下代码

Sub RemoveDuplicatesCells()
'PURPOSE: Remove duplicate cell values within a selected cell range

Dim rng As Range
Dim x As Integer

'Optimize code execution speed
  Application.ScreenUpdating = False

'Determine range to look at from user's selection
  On Error GoTo InvalidSelection
    Set rng = Selection
  On Error GoTo 0

'Determine if multiple columns have been selected
  If rng.Columns.Count > 1 Then
    On Error GoTo InputCancel
      x = InputBox("Multiple columns were detected in your selection. " & _
        "Which column should I look at? (Number only!)", "Multiple Columns Found!", 1)
    On Error GoTo 0
  Else
    x = 1
  End If

'Optimize code execution speed
  Application.Calculation = xlCalculationManual

'Remove entire row
  rng.RemoveDuplicates Columns:=x

'Change calculation setting to Automatic
  Application.Calculation = xlCalculationAutomatic

Exit Sub

'ERROR HANDLING
InvalidSelection:
  MsgBox "You selection is not valid", vbInformation
  Exit Sub

InputCancel:

End Sub

Answer 4

您的数据需要在列中。（您可以使用转置公式来执行必要的操作。）然后，您可以转到Excel的数据选项卡，单击过滤器高级，选择表格范围，给出复制范围，选择唯一记录，最后单击确定。如有必要，再次使用转置公式。

如何删除列的重复项

4 个答案: