Fonction de détection des doublons dans la feuille Excel

Question

J'ai besoin d'une fonction capable de détecter les doublons dans une colonne Excel spécifiée. J'ai celui-ci mais il ne fonctionne pas correctement. Il ne peut pas distinguer entre la valeur "46.500" et la valeur "46.5000". La fonction countif compare probablement les cellules sous forme de nombres. Ces cellules sont formatées en texte et j'ai même essayé d'ajouter une apostrophe avant les nombres. Pas de chance.

Function check_duplicates(column As String) 
LastRow = Range(column & "65536").End(xlUp).row 
For x = LastRow To 1 Step -1 

    If Application.WorksheetFunction.CountIf(Range(column & "1:" & column & LastRow), Range(column & x).Text) > 1 Then 
     check_duplicates = x ' return row with a duplicate 
     x = 1 
    Else 
     check_duplicates = 0 
    End If 
Next x 
End Function 

La prise est la ligne avec Countif.

Est-ce que quelqu'un sait comment forcer la fonction VBA CountIf à comparer des cellules sous forme de chaînes ou autrement pour vérifier les doublons dans VBA?

Answer 1

Je trouve habituellement ado utile dans de telles circonstances.

Dim cn As Object 
Dim rs As Object 

strFile = Workbooks(1).FullName 
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _ 
    & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";" 

Set cn = CreateObject("ADODB.Connection") 
Set rs = CreateObject("ADODB.Recordset") 

cn.Open strCon 

strSQL = "SELECT F2, Count(F2) AS CountF2 FROM [Sheet1$] " _ 
    & "GROUP BY F2 HAVING Count(F2)>1 " 
rs.Open strSQL, cn 

s = rs.GetString 
MsgBox s 

'' Or 
Sheets("Sheet2").Cells(2, 1).CopyFromRecordset rs 

Answer 2

La fonction COUNTIF ne prend pas une formule comme second argument, de sorte que le second argument devrait être:

"=" & Range (colonne & x) .Text

Answer 3

En supposant que tous les « textes «les cellules sont des représentations textuelles de nombres, le changement suivant fonctionnera:

Function check_duplicates(column As String) 
    Dim lastrow As Long 
    Dim x As Long 

    lastrow = Range(column & "65536").End(xlUp).Row 
    For x = lastrow To 1 Step -1 

     If Application.WorksheetFunction.CountIf(Range(column & "1:" & column & lastrow), Val(Range(column & x).Text)) > 1 Then 
      check_duplicates = x ' return row with a duplicate 
      x = 1 
     Else 
     check_duplicates = 0 
     End If 
    Next x 
End Function 

Il contraint la valeur de la cellule de critères à une valeur par l'utilisation de la fonction Val

Answer 4

Voici la nouvelle version basée sur le code de Remou. Celui-ci est un peu plus polyvalent et fonctionne avec MS Excel 2007.

Function check_duplicates(column As Integer) 
' checks for duplicates in a column 
' usage: column - numerical (A = 1, B=2 etc...) 
' returns: "" - no duplicates, otherwise list of duplicates with numbers of occurrences 

Dim cn As Object 
Dim rs As Object 

strFile = ActiveWorkbook.FullName 
strSheet = ActiveWorkbook.ActiveSheet.Name 

' connection string for Excel 2007 
strcon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile & _ 
";Extended Properties=""Excel 12.0 Xml;HDR=No;IMEX=1"";" 

Set cn = CreateObject("ADODB.Connection") 
Set rs = CreateObject("ADODB.Recordset") 

cn.Open strcon 

col = "F" & Trim(Str(column)) 

strsql = "SELECT " & col & ", Count(" & col & ") AS Count" & col & " FROM [" & strSheet & "$]" & _ 
"GROUP BY " & col & " HAVING Count(" & col & ")>1 " 
rs.Open strsql, cn 

If rs.BOF = True And rs.EOF = True Then 
     check_duplicates = "" 
    Else 
     check_duplicates = rs.GetString 
End If 
End Function