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.
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 SubJ'ai fait en sorte qu'il fonctionne même si le tableau n'est pas trié.
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 SubBonjour,
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 SubMErci ausecour :)