2014-10-28 92 views
2

我是Excel中VBA宏的新手,只想问一下在Excel中是否有检查重复记录的函数。如果VBA-excel中存在重复记录,请检查列

下面这行代码删除了引用A列的重复内容,但是我不想在没有用户确认的情况下删除它,我想要做的是要求用户确认他是否希望将其删除,就像一个弹出窗口,然后这行只会执行,但我不知道是否有检查重复的函数。

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

在此先感谢您的帮助。

+0

您可以使用条件格式突出显示重复项,也可以选择删除重复项(如果不需要)。 – 2014-10-28 11:10:34

+0

我认为条件格式不是一个适当的解决方案。如果有任何方法可以检查(只是检查)列中是否存在重复,那就太好了。 – 2014-10-28 11:14:24

+0

http://www.wikihow.com/Find-Duplicates-in-Excel有一些其他的非编码技术。 – barryleajo 2014-10-28 11:37:13

回答

2

请尝试下面的代码。我已经设置脚本使重复单元格为空,但您可以插入自己的代码。

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.在我看来,使用条件格式更容易。

+0

非常感谢你。 :) – 2014-10-29 08:26:41

+0

您随时欢迎您! :) – 2014-10-29 10:05:46