Question

我是VBA的新手，正试图编写一个宏来检查列之间的重复项。我的A到Z列中的值具有不同的最后一行编号，有些可能是5，有些可能是10。有什么方法可以检查列之间是否存在重复值，然后在第一行上打印“ duplicate”（I第一列的所有列都没有任何值）。我需要这个来改变最后一行和最后一列的编号。

Answer 1

您可以尝试：

Option Explicit

Public Sub Get_Unique_Count_Paste_Array()

    Dim Ob As Object
    Dim rng As Range
    Dim i As Long
    Dim str As String
    Dim LR As Long
    Dim Item As Variant

    With Worksheets("Sheet1")

        For i = 1 To 26

            Set Ob = CreateObject("scripting.dictionary")

            LR = .Cells(.Rows.Count, i).End(xlUp).Row

            For Each rng In .Range(Cells(2, i), Cells(LR, i))
                str = Trim(rng.Value)
                If Len(str) > 0 Then
                    Ob(str) = Ob(str) + 1
                End If
            Next rng

            For Each Item In Ob.keys

               If .Cells(1, i).Value = "" Then
                   .Cells(1, i).Value = Item

               ElseIf .Cells(1, i).Value <> "" Then
                   .Cells(1, i).Value = .Cells(1, i).Value & ", " & Item
               End If

            Next Item

        Next i

    End With

  End Sub

编辑版本：

Option Explicit

Public Sub Get_Unique_Count_Paste_Array()

    Dim Ob As Object
    Dim rng As Range
    Dim i As Long
    Dim str As String
    Dim LR As Long
    Dim Item As Variant

    With Worksheets("Sheet1")

        For i = 1 To 26

            Set Ob = CreateObject("scripting.dictionary")

            LR = .Cells(.Rows.Count, i).End(xlUp).Row

            For Each rng In .Range(Cells(2, i), Cells(LR, i))
                str = Trim(rng.Value)
                If Len(str) > 0 Then
                    Ob(str) = Ob(str) + 1
                End If
            Next rng

            For Each Item In Ob.keys

               If .Cells(1, i).Value = "" And Ob(Item) > 1 Then
                    .Cells(1, i).Value = "Duplicate"
                    Exit For
               End If

            Next Item

        Next i

    End With

  End Sub

Answer 2

@error 1004的想法稍作改动

Private d As Scripting.Dictionary
Private s As String

Function Get_Dupe_Summary(rngInput As Excel.Range) as string

Dim c As Excel.Range

    Set d = New Scripting.Dictionary

    For Each c In rngInput.Cells
        If d.Exists(c.Value) Then
            Get_Dupe_Summary = Get_Dupe_Summary & _
                IIf(Len(Get_Dupe_Summary) > 0, ",", "") & _
                "Dupe : " & c & " on row " & c.Row
        Else
            d.Add c.Value, 1
        End If
    Next c

End Function

在所有行号不同的列中查找重复项

2 个答案: