VBA Incrémenter si doublon Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
N
Nico44044
Membre habitué
Membre habitué
Messages : 119
Inscrit le : 2 janvier 2017
Version d'Excel : Excel Mac 2011

Message par Nico44044 » 6 mars 2018, 16:00

Bonjour à tous,

J'ai cette macro qui repère les doublons en colonne A( uniquement des valeurs numérique) , et ouvre une MsgBox pour me donner la valeur et l'adresse de la cellule ou est situé le doublon.

Ce que je voudrais c'est qu'à la place de du MsgBox, la macro remplace automatiquement le doublon trouvé par la valeur la plus élevée de la colonne A et ajouter +1.

par ex :

COL A
1
2
3
4
4
5
6

=> je veux que le premier "4" se transforme en "7".

Voici ma macro d'origine si ca vous donne une piste.
Sub Doublon()
Dim Plage As Range
    Dim Cel As Range
 
    With Worksheets("salarié")
 
    'en colonne "A" à partir de A2
       Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
 
    End With
 
 
    'boucle la plage de la feuille "Compte" et cherche chaque valeur
   'en correspondance exacte dans la plage de la feuille "Source"
   For Each Cel In Plage
 
        If Application.CountIf(Plage, Cel.Value) > 1 Then
 
                   MsgBox Cel.Value & Cel.Address(0, 0)
               
 
            Cel.Interior.ColorIndex = 3
 
        End If
 
    Next Cel
    
    End Sub

Merci a celui qui me trouvera la solution :)

Nico
N
Nico44044
Membre habitué
Membre habitué
Messages : 119
Inscrit le : 2 janvier 2017
Version d'Excel : Excel Mac 2011

Message par Nico44044 » 6 mars 2018, 23:11

Je me répond à moi meme du coup pour ceux que ca aidera

J'ai utilisé la fonction Application.WorksheetFunction.Max

Voici le code
Sub Doublon()
Dim Plage As Range
    Dim Cel As Range
 
    With Worksheets("salarié")
 
    'en colonne "A" à partir de A2
       Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
 
    End With
 
 
    'boucle la plage de la feuille "Compte" et cherche chaque valeur
   'en correspondance exacte dans la plage de la feuille "Source"
   vmax = Application.WorksheetFunction.Max(Plage) + 1
   For Each Cel In Plage
 
        If Application.CountIf(Plage, Cel.Value) > 1 Then
 
                    Cel.Value = vmax
               
 
            Cel.Interior.ColorIndex = 3
 
        End If
 
    Next Cel
    
    End Sub
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message