检查重复项目

Question

有什么方法可以一次性检查重复的项目，而不是像下面的代码所示单独进行检查？

Private Sub checkDuplicates(wks As Worksheet)
    Dim lastRow As Long: lastRow = Cells(wks.Rows.Count, "E").End(xlUp).Offset(1, 0).row
    Dim n, i, j As Long, found As Range

    For n = 0 To ListboxResult.ListCount - 1
        Set found = wks.Range("E4", "E" & lastRow).Find(Me.ListboxResult.List(n, 1))
        If Not found Is Nothing Then
            MsgBox "Item " & Me.ListboxResult.List(n, 1) & " is duplicated", vbOKOnly, "Duplicated items"
        Else
            Call addToNewRow(wks, lastRow, n)
            
            lastRow = lastRow + 1
        End If
    Next n
End Sub

Answer 1

我认为没有办法在没有循环的情况下做到这一点。您所要做的就是避免在循环内向用户显示重复消息。

相反，收集所有重复项，当循环停止时（并且您发现任何重复项），将其显示给用户。

您的代码可能如下所示：

Dim duplicates As String, duplicateCount As Long
For n = 0 To ListboxResult.ListCount - 1
    Dim item As String
    item = Me.ListboxResult.List(n, 1)
    Set found = wks.Range("E4", "E" & lastRow).Find(item)
    If Not found Is Nothing Then
         duplicates = duplicates & IIf(duplicateCount = 0, "", ", ") & item
         duplicateCount = duplicateCount + 1
    Else
        Call addToNewRow(wks, lastRow, n)
        lastRow = lastRow + 1
    End If
Next n

If duplicateCount = 1 Then
    MsgBox "Item " & duplicates & " is duplicated", vbOKOnly, "Duplicate item"
ElseIf duplicateCount > 1 Then
    MsgBox "Items " & duplicates & " are duplicated", vbOKOnly, duplicateCount & "Duplicate items"
End If