Question

我有一个excel表有一些重复，我们目前有这些重复，但我想为每个副本填充一个唯一的数字。 e.g。

Number  Count   Sequence
1          2    1
1          2    1
2          3    2
2          3    2
2          3    2
3          4    3
3          4    3
3          4    3
3          4    3
4          2    4
4          2    4
5          5    5
5          5    5
5          5    5
5          5    5
5          5    5

我正在使用以下IF语句，但我希望它检查整个范围并检查它是否有错误的顺序但仍然相同。

=IF(IF(IF(A2=A1,TRUE,FALSE)=FALSE,1,0)>=0,IF(IF(A2=A1,TRUE,FALSE)=FALSE,1,0)+D1,IF(IF(A2=A1,TRUE,FALSE)=FALSE,1,0))

这可能吗？

Answer 1

您可以首先遍历该列并使用集合获取唯一项目。

这部分代码：

   On Error Resume Next
        For Each Cell In Rng.Cells
            cUnique.Add Cell.Value, CStr(Cell.Value)
        Next Cell

只会获取唯一的项目，因为项目集合不能重复。

使用此选项对重复项进行编号。根据需要更改工作表名称。

    Sub NumberDupes()
    Dim cUnique As Collection
    Dim Rng As Range
    Dim Cell As Range
    Dim sh As Worksheet
    Dim vNum As Variant
    Dim LstRw As Long
    Dim c As Long, clr As Long, x, r As Range

    Set sh = Sheets("Sheet2")
    With sh
        .Columns("B:B").ClearContents
        LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set Rng = .Range(.Cells(2, 1), .Cells(LstRw, 1))
        Set cUnique = New Collection
        Rng.Interior.ColorIndex = xlNone
        clr = 1

        On Error Resume Next
        For Each Cell In Rng.Cells
            cUnique.Add Cell.Value, CStr(Cell.Value)
        Next Cell
        On Error GoTo 0

        For Each vNum In cUnique
            For c = 1 To LstRw
                Set r = .Cells(c, 1)
                x = Application.WorksheetFunction.CountIf(.Range(.Cells(1, 1), .Cells(c, 1)), r)
                If r = vNum Then
                    If x > 1 Then
                        r.Offset(, 1) = clr
                    End If
                End If
            Next c
            clr = clr + 1
        Next vNum

    End With

End Sub

使用它来着色重复项，这将适用于小规模，取决于有多少独特的项目，但这是一个很酷的例子。我的回答here.

编辑了代码

Sub ColorDupes()
    Dim cUnique As Collection
    Dim Rng As Range
    Dim Cell As Range
    Dim sh As Worksheet
    Dim vNum As Variant
    Dim LstRw As Long
    Dim c As Long, clr As Long, x, r As Range

    Set sh = Sheets("Sheet2")
    With sh

        LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set Rng = .Range(.Cells(2, 1), .Cells(LstRw, 1))
        Set cUnique = New Collection
        Rng.Interior.ColorIndex = xlNone
        clr = 3

        On Error Resume Next
        For Each Cell In Rng.Cells
            cUnique.Add Cell.Value, CStr(Cell.Value)
        Next Cell
        On Error GoTo 0

        For Each vNum In cUnique
            For c = 1 To LstRw
                Set r = .Cells(c, 1)
                x = Application.WorksheetFunction.CountIf(.Range(.Cells(1, 1), .Cells(c, 1)), r)
                If r = vNum Then
                    If x > 1 Then
                        r.Interior.ColorIndex = clr
                    End If
                End If
            Next c
            clr = clr + 1
        Next vNum

    End With

End Sub

Answer 2

它会将唯一引用添加到一个列中，该列距离您设置的col等于3列。

它还要求col + 3为空白，这样可以使检查更容易。

Sub SomeSub()

    Dim Array1 As Variant
    Dim Array2 As Variant

    With ActiveSheet.UsedRange
        LastRow = .Rows(.Rows.Count).Row
    End With

    'Setting up the array for assigning each row value to the array
    ReDim Array1((LastRow + 1))
    ReDim Array2((LastRow + 1))

    'Here youwill set what column is the "Number" Column
    col = 1

    'Assigning the row data into the arrays
    'Starting at 2 to skip the title row
    For r = 2 To LastRow
            'Values in Column 1 go to Array1
            Array1(r) = Cells(r, col)
            'Values in Column 2 go to Array2
            Array2(r) = Cells(r, col + 1)
    Next r

    'Setting unquie ref to 1
    Seq = 1
    'Running through each row of data
    For i = 2 To LastRow

        'col + 3 refers to a column on beyond the Sequence colum
        'If the column is blank then that row has not been checked yet
        If Cells(i, col + 3) = "" Then

            'Assign the Uniqui ref to the row
            Cells(i, col + 3).Value = Seq

            'Running through the rest of the rows to check if they are like the current row
            For n = i + 1 To (LastRow)

                'If cell is blank then the row has been checked
                If Cells(n, col + 3) = "" Then

                    'Array(i) is the current row
                    'Array(n) are the leading rows after row i
                    'If the current row is the same as any leading row then the uniquie ref = seq
                    If Array1(i) = Array1(n) And Array2(i) = Array2(n) Then Cells(n, col + 3).Value = Seq

                'Else a value has been added
                Else

                    'Do nothing

                End If

            Next n

            'Increment the seq
            Seq = Seq + 1

        'Ending the If Cells(i, col + 3) = "" Then
        End If

    Next i

End Sub

Answer 3

C1仅1和C2：

=MIN(IF(($A$2:A2=A3)*($B$2:B2=B3),$D$2:D2,MAX($D$2:D2)+1))

这是一个数组公式，必须使用 Ctrl + Shift + Enter 确认。

只需从C3

自动填写嗯......我想我弄错了：/

如果仅查看A栏，那么这应该足够了：

=MIN(IF($A$2:A2=A3,$D$2:D2,MAX($D$2:D2)+1))

这是一个数组公式，必须使用 Ctrl + Shift + Enter 确认。

看着你的公式，它可以缩短：

=IF(IF(IF(A2=A1,TRUE,FALSE)=FALSE,1,0)>=0,IF(IF(A2=A1,TRUE,FALSE)=FALSE,1,0)+D1,IF(IF(A2=A1,TRUE,FALSE)=FALSE,1,0))
  'IF(A2=A1,TRUE,FALSE)=FALSE ==>> A1<>A2    
=IF(IF(A1<>A2,1,0)>=0,IF(A1<>A2,1,0)+D1,IF(A1<>A2,1,0))
  'IF(A1<>A2,1,0)>=0 ==>> TRUE
=IF(TRUE,IF(A1<>A2,1,0)+D1,IF(A1<>A2,1,0))
  'IF(TRUE => allways true
=IF(A1<>A2,1,0)+D1
  'last skip
=D1+(A1<>A2)

为每个唯一值提供唯一引用

3 个答案: