如果VBA-excel中存在重複記錄，請檢查列

Question

我是Excel中VBA宏的新手，只想問一下在Excel中是否有檢查重複記錄的函數。

下面這行代碼刪除了引用A列的重複內容，但是我不想在沒有用戶確認的情況下刪除它，我想要做的是要求用戶確認他是否希望將其刪除，就像一個彈出窗口，然後這行只會執行，但我不知道是否有檢查重複的函數。

ActiveSheet.Range("$A$1:$D$38").RemoveDuplicates Columns:=1 

在此先感謝您的幫助。

Answer 1

請嘗試下面的代碼。我已經設置腳本使重複單元格爲空，但您可以插入自己的代碼。

Sub FindDuplicates() 

    Dim i As Long 
    Dim j As Long 
    Dim lDuplicates As Long 

    Dim rngCheck As Range 
    Dim rngCell As Range 
    Dim rngDuplicates() As Range 

    '(!!!!!) Set your range 
    Set rngCheck = ActiveSheet.Range("$A$1:$D$38") 

    'Number of duplicates found 
    lDuplicates = 0 

    'Checking each cell in range 
    For Each rngCell In rngCheck.Cells 
     Debug.Print rngCell.Address 
     'Checking only non empty cells 
     If Not IsEmpty(rngCell.Value) Then 

      'Resizing and clearing duplicate array 
      ReDim rngDuplicates(0 To 0) 
      'Setting counter to start 
      i = 0 

      'Starting search method 
      Set rngDuplicates(i) = rngCheck.Find(What:=rngCell.Value, After:=rngCell, LookIn:=xlValues, _ 
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext) 

      'Check if we have at least one duplicate 
      If rngDuplicates(i).Address <> rngCell.Address Then 

       'Counting duplicates 
       lDuplicates = lDuplicates + 1 

       'If yes, continue filling array 
       Do While rngDuplicates(i).Address <> rngCell.Address 
        i = i + 1 
        ReDim Preserve rngDuplicates(0 To i) 
        Set rngDuplicates(i) = rngCheck.FindNext(rngDuplicates(i - 1)) 
       Loop 

       'Ask what to do with each duplicate 
       '(except last value, which is our start cell) 
       For j = 0 To UBound(rngDuplicates, 1) - 1 
        Select Case MsgBox("Original cell: " & rngCell.Address _ 
             & vbCrLf & "Duplicate cell: " & rngDuplicates(j).Address _ 
             & vbCrLf & "Value: " & rngCell.Value _ 
             & vbCrLf & "" _ 
             & vbCrLf & "Remove duplicate?" _ 
             , vbYesNoCancel Or vbExclamation Or vbDefaultButton1, "Duplicate found") 

         Case vbYes 
          '(!!!!!!!) insert here any actions you want to do with duplicate 
          'Currently it's set to empty cell 
          rngDuplicates(j).Value = "" 
         Case vbCancel 
          'If cancel pressed then exit sub 
          Exit Sub 
        End Select 
       Next j 
      End If 
     End If 
    Next rngCell 

    'Final message 
    Call MsgBox("Total number of duplicates: " & lDuplicates & ".", vbExclamation Or vbDefaultButton1, Application.Name) 

End Sub 

P.S.如果您只需要在一列內刪除漫畫，則需要將rngCheck變量調整爲該特定列。

P.P.S.在我看來，使用條件格式更容易。