les doublons dans une plage de cellules

[aissaoui]

Bonjour tout le monde,
j'aimerais bien savoir comment calculer avec vba les redondances pour chaque nombre d'une plage de cellules et coller le résultat obtenu dans un autre classeur excel que le premier.
si vous arrivez à m'écrire un code type je serais trés reconnaissant
et merci d'avance.

 

[Dormeur74]

Re : les doublons dans une plage de cellules

Une approche de laboureur, mais qui marche. J'ai collé les doublons dans la feuille 2. Tu n'auras aucun mal à mettre le résultat dans un autre classeur. Eventuellement tu sauvegardes le classeur courant sous un autre nom, puis tu détruis la feuille 1 et renommes la feuille 2.

Option Explicit

Sub Macro1()
    Dim nbRows As Long
    Dim nbCols As Integer
    Dim x As Integer, y As Long
    Dim nbCells As Long
    Dim Pointeur As Long
    
    ' On copie la feuille1 dans la feuille 2
    Cells.Select
    Range("A20").Activate
    Selection.Copy
    Sheets("Feuil2").Select
    Cells.Select
    ActiveSheet.Paste
    Worksheets("Feuil2").Select
    
    ' On calcule le nombre de colonnes du tableau
    nbCols = ActiveSheet.UsedRange.Columns.Count
    
    ' On recopie les colonnes 2 à nbcols dans la colonne 1
    For x = 2 To nbCols
        Pointeur = Cells(Rows.Count, 1).End(xlUp).Row
        nbCells = Cells(Rows.Count, x).End(xlUp).Row + 1
        For y = 1 To nbCells
            Cells(y + Pointeur, 1) = Cells(y, x)
        Next y
    Next x
    
    ' On supprime les cellules vides s'il y en a
    Pointeur = Cells(Rows.Count, 1).End(xlUp).Row
    For y = Pointeur To 1 Step -1
        If Cells(y, 1) = "" Then
            Rows(y).Select
            Selection.Delete Shift:=xlUp
        End If
    Next y
    
    ' On ne garde que la colonne 1
    For x = nbCols To 2 Step -1
        Columns(x).Select
        Selection.Delete Shift:=xlToLeft
    Next x
    
    ' On trie la feuille sur la colonne 1
    Cells.Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

    ' et on détruit les lignes contenant des valeurs non répétées
    For y = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
        If Cells(y, 1) = Cells(y - 1, 1) Or Cells(y, 1) = Cells(y + 1, 1) Then
        Else
            Rows(y).Select
            Selection.Delete Shift:=xlUp
        End If
    Next y
    
    If Cells(1, 1) <> Cells(2, 1) Then
        Rows(1).Select
        Selection.Delete Shift:=xlUp
    End If
    ' Il ne reste que les doublons
End Sub

 

[aissaoui]

Re : les doublons dans une plage de cellules

Bonsoir,
Merci Dormeur74 pour le code; J'aimerais bien avoir un code qui calcule le nombre de doublons d'un chiffre donné dans une plage et retoune le résultat pour le coller dans un autre classeur.
vous trouvez ci-joint le lien de deux classeurs qui expliquent la situation.

[ Classeurs 1et 2.rar - 4shared.com - partage et stockage de fichiers en ligne - télécharger ]