Question

我的excel文件允许用户上传新报告，每个报告可以包含多个发票（Excel上每个发票= 1行）。如果用户导入了一个新报告，但似乎已经根据两个条件上传了该报告：如果日期 AND 该名称已经出现在过去的数据中，则可以选择替换或保留旧发票。

在这里找到此代码并将其修改为我的工作表： How to Check for duplicates in 2 columns and copy the entire row into another sheet?

Sub Check()

Dim lw As Long, i As Long
  With targetSheet
     lw = .Range("A" & .Rows.Count).End(xlUp).Row
     For i = 2 To lw 
        If Application.CountIfs(Range("B" & i & ":B" & lw), Range("B" & i).Text, _
        Range("E" & i & ":E" & lw), Range("E" & i)) > 1 Then
            MsgBox ("A report was made on [DATE] with [NAME]. Do you want to replace the existing report or cancel?")
        End If
    Next i
  End With

End Sub

当我运行它时，它给了我错误：运行时错误'424'：必需对象

我还找到了该站点：https://docs.microsoft.com/en-us/office/vba/excel/concepts/cells-and-ranges/prevent-duplicate-entries-in-a-range，但不确定如何进行修改。.

Answer 1

尝试做类似这样的事情，@ Jade：

Public Sub Check()

Dim lw As Long, i As Long

Worksheets("SheetName").Activate

lw = ActiveSheet.Range("A1048576").End(xlUp).Row

    For i = 2 To lw 
        If Application.CountIfs(ActiveSheet.Range("B" & i & ":B" & lw), ActiveSheet.Range("B" & i).Value, ActiveSheet.Range("E" & i & ":E" & lw), ActiveSheet.Range("E" & i).Value) > 1 Then
            MsgBox "A report was made on [DATE] with [NAME]. Do you want to replace the existing report or cancel?", vbYesNo, "Title of MSGBOX"
            Exit For
        End If
    Next i

End Sub

Answer 2

Option Explicit

Sub Check()

    Dim LastRow As Long, i As Long

      With ThisWorkbook.Worksheets("Sheet1") '<- Change if needed

         LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row '<- We assume that all columns have the same number of rows

         For i = 2 To LastRow '<- Start loop from second row
            'Let as assume that "Date" appears in column B. Check for duplicates
            If Application.CountIfs(.Range("B2" & ":B" & LastRow), .Range("B" & i).Value) > 1 Then '<- In order to find the duplicates in whole column avoid using i (used 1 or 2 depended on the row from where the range starts) in the range for search & add "." before range.
                'Let as assume that "Name" appears in column E. Check for duplicates
                If Application.CountIfs(.Range("E2" & ":E" & LastRow), .Range("E" & i).Value) > 1 Then
                    MsgBox ("A report was made on [DATE] with [NAME]. Do you want to replace the existing report or cancel?")
                End If
            End If

        Next i

      End With

End Sub

检查两列中是否有重复项，如果是，则替换为新数据还是保留旧数据？ VBA

2 个答案: