Ajouter les valeurs non existantes

Le
Apitos
Bonjour,

J'ai deux colonnes A et F de produits.

J'aimerais ajouter dans F tout les valeurs de la colonne A non
existantes dans F.

Merci.
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Apitos
Le #6430101
J'ai ouiblié de mettre le code qui ne marchait pas :


Sub CopiePrd()
Set mondico = CreateObject("Scripting.Dictionary")

'-------- lecture anciens
Set f = Sheets("Prd")
If [F2] <> "" Then
For Each c In f.Range("F2", f.[F65000].End(xlUp))
mondico.Add c.Value, ""
Next c
End If
'-------------------------
'------- ajout nouveaux
Set f = Sheets("Prd")
MsgBox "derniere ligne dans Prd Col A : " & f.
[A65000].End(xlUp).Row
For Each c In f.Range("A2", f.[A65000].End(xlUp))
If Not mondico.Exists(c.Value) Then
MsgBox "Prd nouv : " & c.Value
mondico.Add c.Value, ""
End If
Next c


'----------- faire une copie dans Colonne F ----
[F2].Resize(mondico.Count, 1) =
Application.Transpose(mondico.keys)
[G2].Resize(mondico.Count, 1) =
Application.Transpose(mondico.items)
Range("F2", [F65000].End(xlUp)).Sort Key1:=Range("F2"),
Order1:=xlAscending, Header:=xlGuess
Set mondico = Nothing

End Sub

---------------

Merci.
francois.forcet
Le #6430381
Salut à toi
Soit La Feuil1 à traiter
Colonne A la source
Colonne B à compléter
Je te propose ce code :

For Each c In Worksheets("Feuil1").Range("A2", "A" &
Range("A65535").End(xlUp).Row)
Range("B1").Activate
On Error Resume Next
Range("B1", "B" & Range("B65535").End(xlUp).Row).Find(What:=c,
After:=Range("B1"), LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:úlse).Activate
If ActiveCell.Address = Range("B1").Address Then
Range("B65535").End(xlUp).Offset(1, 0) = c
End If
Next

Celà devrait convenir

Dis moi !!!!
Jacky
Le #6430821
Bonjour,
J'aimerais ajouter dans F tout les valeurs de la colonne A non existantes
dans F.


Ceci peut-être..
'--------
Sub jj()
For Each c In Range("A1:a" & [a65536].End(3).Row)
If Application.CountIf(Range("F:F"), c) = 0 Then Range("f" &
[f65536].End(3).Row + 1) = c
Next
End Sub
'----------

--
Salutations
JJ


"Apitos"
J'ai ouiblié de mettre le code qui ne marchait pas :


Sub CopiePrd()
Set mondico = CreateObject("Scripting.Dictionary")

'-------- lecture anciens
Set f = Sheets("Prd")
If [F2] <> "" Then
For Each c In f.Range("F2", f.[F65000].End(xlUp))
mondico.Add c.Value, ""
Next c
End If
'-------------------------
'------- ajout nouveaux
Set f = Sheets("Prd")
MsgBox "derniere ligne dans Prd Col A : " & f.
[A65000].End(xlUp).Row
For Each c In f.Range("A2", f.[A65000].End(xlUp))
If Not mondico.Exists(c.Value) Then
MsgBox "Prd nouv : " & c.Value
mondico.Add c.Value, ""
End If
Next c


'----------- faire une copie dans Colonne F ----
[F2].Resize(mondico.Count, 1) Application.Transpose(mondico.keys)
[G2].Resize(mondico.Count, 1) Application.Transpose(mondico.items)
Range("F2", [F65000].End(xlUp)).Sort Key1:=Range("F2"),
Order1:=xlAscending, Header:=xlGuess
Set mondico = Nothing

End Sub

---------------

Merci.

Apitos
Le #6431331
Merci François et Jacky.

Je crois que je vais prendre le code de Jacky (il est plus léger!).

Bon pour le même code, mais cette fois-ci j'aimerais faire une mise à
jour des colonnes F & G depuis les colonnes A & B.

Les en-tetes sont : Catégorie (A-F) --- Abréviation (B-G).

Merci.
francois.forcet
Le #6431621
Rebonjour à toi

J'ai beaucoup de mal à comprendre ta 2° demande
Peux tu être plus explicite

Merci
Jacky
Le #6433921
Re..
Essaie ceci
'-------------
Sub CopieCat()
'-------- Completer la colonne F et G depuis la colonne A et B
For Each c In Range("A2:A" & [A65536].End(3).Row)
If Application.CountIf(Range("F:F"), c) = 0 Then
Range("F" & [F65536].End(3).Row + 1) = c
Range("g" & [F65536].End(3).Row) = c.Offset(0, 1)
End If
Next

'---- Tri
Range("F2", [G65000].End(xlUp)).Sort Key1:=Range("F2"),
Order1:=xlAscending, Header:=xlGuess
End Sub
'------------------

--
Salutations
JJ


"Apitos"
Voilà un petit exemple :

http://cjoint.com/?eDschAWZz8
Apitos
Le #6440381
Bonsoir,

Merci Jacky.

Ca marche.
Publicité
Poster une réponse
Anonyme