Ajout de _1, _2, _3 etc.. si plusieurs valeurs

Bonjour à toutes et à tous

Voici mon souci.

J'ai une colonne dans un fichier XLSXM. Cette colonne contient des valeurs. Il y a parfois des valeurs qui sont en doubles, triples, etc.

Il faut que si la valeur se retrouve en double, la première valeur rencontrée ait le suffixe _1 à la fin, la deuxième _2 et ainsi de suite. Il faut que la valeur soit modifiée dans la colonne source et non dans une nouvelle colonne.

Le tout en macro. C'est pour un processus de validation/intégration de données.

Je joint un fichier avec les colonnes "Valeur existante" et "valeur attendue" pour illustrer mon propos.

Un gros merci care je ne sais pas trop par où commencer

Bonne journée.

17ajout.xlsm (8.90 Ko)

Bonjour,

Voici le code dont vous avez besoin:

Sub test()
Dim Valeurs As New Collection, Lignes As New Collection
Dim tableau As Variant
Dim ligFin As Integer
Dim cle As String

'initialisations
ligFin = Range("A" & Rows.Count).End(xlUp).Row
tableau = Range("A2", "A" & ligFin).Value

'parcours du tableau pour lister les lignes avec la valeur
For i = 1 To UBound(tableau, 1)
    nb = 0
    cle = tableau(i, 1)

    On Error Resume Next
    nb = Valeurs(cle).Count
    On Error GoTo 0

    If nb = 0 Then
        Valeurs.Add New Collection, cle
    End If

    Valeurs(cle).Add i
Next i

'parcours des différentes valeurs
For i = 1 To Valeurs.Count
    Set Lignes = Valeurs(i)

    'si valeur en double
    If Lignes.Count > 1 Then
        For x = 1 To Lignes.Count
            'ajout de _x
            tableau(Lignes(x), 1) = tableau(Lignes(x), 1) & "_" & x
        Next x
    End If
Next i

'export du résultat
Range("A2").Resize(UBound(tableau, 1), 1).Value = tableau
End Sub

J'ai fait en sorte qu'il fonctionne même si le tableau n'est pas trié.

Bonjour

Bonjour à tous

Une vaeriante

13ajout-v1.xlsm (17.42 Ko)

Bye !

Bonjour Ausecours.

MERci pour ton aide. Ca fonctionne super bien.

J'ai modifier la colonne pour C (qui correspond à mes données réelles) et j'ai modifier le nombre de ligne à 200.

J'ai essayer d'ajouter une condition pour les valeurs nulles. Donc que s'il n'y a pas de valeur dans la colonne C, que la macro ne s'applique pas.

MAis ca ne fonctionne pas.

Pourrais-tu m'aiguiller svp.

Merci encore

Sub ajout_chiffre_doublons()
Dim Valeurs As New Collection, Lignes As New Collection
Dim tableau As Variant
Dim ligFin As Integer
Dim cle As String

'initialisations
ligFin = Range("C" & 200).Row
tableau = Range("C4", "c" & 200).Value

'parcours du tableau pour lister les lignes avec la valeur
For i = 1 To UBound(tableau, 1)

'NE pas calculer si valeur nulle
If Active.cell = "" Then GoTo next X

    nb = 0
    cle = tableau(i, 1)

    On Error Resume Next
    nb = Valeurs(cle).Count
    On Error GoTo 0

    If nb = 0 Then
        Valeurs.Add New Collection, cle
    End If

    Valeurs(cle).Add i
Next i

'parcours des différentes valeurs
For i = 1 To Valeurs.Count
    Set Lignes = Valeurs(i)

    'si valeur en double
    If Lignes.Count > 1 Then
        For x = 1 To Lignes.Count
            'ajout de _x
            tableau(Lignes(x), 1) = tableau(Lignes(x), 1) & "_" & x
        Next x
    End If
Next i

'export du résultat
Range("c4").Resize(UBound(tableau, 1), 1).Value = tableau
End Sub

Bonjour,

Il n'y avait pas besoin de préciser la ligne 200, la macro s'occupe déjà de calculer la position de la dernière ligne remplie.

Juste modifier la ligne de départ pour déclarer le tableau en prenant C4.

Pour la condition de cellule non vide: If Not tableau(i,1) = "" Then

Le code complet:

Sub ajout_chiffre_doublons()
Dim Valeurs As New Collection, Lignes As New Collection
Dim tableau As Variant
Dim ligFin As Integer
Dim cle As String

'initialisations
ligFin = Range("C" & Rows.Count).End(xlUp).Row
tableau = Range("C4", "C" & ligFin).Value

'parcours du tableau pour lister les lignes avec la valeur
For i = 1 To UBound(tableau, 1)

    'Ne pas calculer si valeur nulle
    If Not tableau(i, 1) = "" Then
        nb = 0
        cle = tableau(i, 1)

        On Error Resume Next
        nb = Valeurs(cle).Count
        On Error GoTo 0

        If nb = 0 Then
            Valeurs.Add New Collection, cle
        End If

        Valeurs(cle).Add i
    End If
Next i

'parcours des différentes valeurs
For i = 1 To Valeurs.Count
    Set Lignes = Valeurs(i)

    'si valeur en double
    If Lignes.Count > 1 Then
        For x = 1 To Lignes.Count
            'ajout de _x
            tableau(Lignes(x), 1) = tableau(Lignes(x), 1) & "_" & x
        Next x
    End If
Next i

'export du résultat
Range("c4").Resize(UBound(tableau, 1), 1).Value = tableau
End Sub

MErci ausecour :)

Rechercher des sujets similaires à "ajout etc valeurs"