检查重复的项目-解网

问：

有没有办法一次性检查重复的项目，而不是像下面的代码所示单独检查？

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

VBA 用户窗体

我想一次性检查重复的项目，而不是单独检查它们。例如，如果我在列表框中有“a”，并且我再次单击提交，它将显示项目重复。然后，如果我在列表框中放置另一个项目“b”，它会说“a”是重复的。所以我不希望在我的程序中出现这种情况。我想检查列表框中是否显示“a，b，c”，如果我再次单击提交，它应该说项目重复。@FunThomas

0赞 FunThomas 11/16/2023

啊，所以你只是想避免用户收到多个错误消息？

答：

0赞 FunThomas 11/16/2023 #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

检查重复的项目

check duplicated items

评论

评论