Ne garder qu'une suite de valeurs... Dur à expliquer en quelques mots ^^

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion flint6593
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
F

flint6593

XLDnaute Occasionnel
Bonjour,

Je viens vous voir, car vous m'avez sortis de la panade plus d'une fois! 😀😀

Voilà en faite j'aimerais ne garder que les doublons. Mais pas seulement.
Je vous explique: 😕

- En fait dans la colonnes A, j'ai des références de produits.
(j'ai une macro pour trouver les doublons)

- Dans la colonne B, j'ai les lieux de stockage: I ou D

=> J'aimerais ne garder que les doublons qui ont dans leurs colonne B, I et D.

Pour connaître les produits qui sont en double dans les stocks des lieux I et D.😕😕😕

Savoir si ils sont en double dans I ou en double dans D ne m’intéresse pas...

J'espère avoir été assez explicite... J'ai un peu de mal à m'expliquer 🙂

Si jamais vous pouviez m'aider ce serait sympa... J'ai plus de 25000 références à traiter...

Merci!
 
Trier par date Trier par votes
Re : Ne garder qu'une suite de valeurs... Dur à expliquer en quelques mots ^^

Re,

Pas certain d'avoir bien saisi l'idée de doublons sur 2 lieux.

Voyez le fichier joint avec cette macro :

Code: 
Sub Doublons2Lieux()
Dim Produit, n&, Lieu, tablo$(), d As Object, i&, lig1, lig2
Produit = Application.Transpose(Range("A2", [A65536].End(xlUp)))
n = UBound(Produit)
Lieu = Application.Transpose([B2].Resize(n))
ReDim tablo(1 To n)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To n
  lig1 = Application.Match(Produit(i) & "µI", tablo, 0)
  lig2 = Application.Match(Produit(i) & "µD", tablo, 0)
  If IsNumeric(lig1) And IsNumeric(lig2) Then _
    d(Produit(i)) = Produit(i)
  tablo(i) = Produit(i) & "µ" & Lieu(i)
Next
'---restitution---
[D2:D65536].ClearContents
If d.Count Then [D2].Resize(d.Count) = Application.Transpose(d.items)
End Sub
Dites-nous si c'est ce que vous voulez.

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Ne garder qu'une suite de valeurs... Dur à expliquer en quelques mots ^^

En fait à mon boulot, on est en train de faire les inventaires, car on viens de regrouper sur un réseaux nos deux entrepôts.
Et il faut que j'identifie les pièces que l'on a en double dans les deux stocks.

Je n'ai pas besoin d'identifier les doubles dans le même lieux, car je les connais déjà.

Je vous met un fichier en exemple.

Le violet, c'est ce que je dois garder (supprimer tous le reste), le jaune, c'est les doublons mais dans le même lieu de stockage...

Merci!!!!!!
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Ne garder qu'une suite de valeurs... Dur à expliquer en quelques mots ^^

Bonjour flint6593, le forum,

Non, j'avais compliqué inutilement.

Vous recherchez simplement les produits qui sont dans l'un et l'autre lieu.

En fait il ne s'agit pas de doublons.

La macro est plus simple :

Code: 
Sub Doublons2Lieux()
Dim Produit, n&, Lieu, tablo$(), d As Object, i&, lig
Produit = Application.Transpose(Range("A1", [A65536].End(xlUp)))
n = UBound(Produit)
Lieu = Application.Transpose([B1].Resize(n))
ReDim tablo(1 To n)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To n
  lig = Application.Match(Produit(i) & IIf(Lieu(i) = "I", "D", "I"), tablo, 0)
  If IsNumeric(lig) Then d(Produit(i)) = Produit(i)
  tablo(i) = Produit(i) & Lieu(i)
Next
'---restitution---
[D2:D65536].ClearContents
If d.Count Then [D2].Resize(d.Count) = Application.Transpose(d.items)
End Sub
J'ai aussi supprimé le séparateur "µ" qui normalement ne sert à rien.

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Ne garder qu'une suite de valeurs... Dur à expliquer en quelques mots ^^

Vraiment merci de votre aide!!!!
C'est super sympa! Car je me voyais mal faire les 25000 référence à la main ^^

MERCI!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
Vote positif 0 Vote négatif
Re : Ne garder qu'une suite de valeurs... Dur à expliquer en quelques mots ^^

Alors la macro pour 35000 lignes environ, avec le masquage de l’exécution de la macro (true, false) et un ordi portable assez vieux:

XP SP2, Intel CPU T2400, 1,83Ghz, 1gb de ram

Utilisation d'une version de office 2007 en portable.

1148, 625 secondes!!!!

Tcho et merci!!!!!
 
Vote positif 0 Vote négatif
Re : Ne garder qu'une suite de valeurs... Dur à expliquer en quelques mots ^^

Re,

J'ai aussi fabriqué par copier/coller du tableau un fichier de 25000 lignes.

Sur mon ordi fixe (2 Ghz) la version (2) s'exécute en 7 mn 38 s.

C'est très long et c'est dû à Application.Match (fonction EQUIV).

Alors j'ai modifié la macro en faisant un tri préalable sur les 2 colonnes A et B :

Code: 
Sub Doublons2Lieux()
Dim t#, Produit, n&, Lieu, d As Object, i&, txt$
t = Timer
[A:B].Sort [A1], xlAscending, [B1], , xlAscending, Header:=xlGuess 'double tri
Produit = Application.Transpose(Range("A1", [A65536].End(xlUp)))
n = UBound(Produit)
Lieu = Application.Transpose([B1].Resize(n))
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To n
  If Lieu(i) = "D" Then
    txt = Produit(i)
1   If i < n Then
      If Produit(i + 1) = txt Then
        i = i + 1
        If Lieu(i) = "I" Then d(Produit(i)) = Produit(i): GoTo 2
        GoTo 1
      End If
    End If
  End If
2 Next
'---restitution---
[D2:D65536].ClearContents
If d.Count Then [D2].Resize(d.Count) = Application.Transpose(d.items)
MsgBox "Durée : " & Format(Timer - t, "0.00") & " seconde(s)"
End Sub
Version (3).

Chez moi le traitement se fait maintenant en 0,11 seconde 🙂

Dites-nous ce que ça donne sur votre fichier réel.

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Ne garder qu'une suite de valeurs... Dur à expliquer en quelques mots ^^

C'est parfait!!!!!! Vraiment sympa!!!! Je commence à avoir pas mal de macro sous la main 🙂

Pendant que j'y suis, mais vu que tu as l'air super fort en macro, j'ai un autre petit soucis (si possible ne pas rouvrir un post, je veux pas polluer)😛

- J'ai des références de produits dans la colonne A
- dans la colonne B j'ai les différentes informations suivant le vécu de la pièce
- chaque information est sur une ligne, donc le référence en A est écrit plusieurs fois

J'aimerais garder seulement la dernière infos de chaque référence de pièce... (en violet)

Les infos que j'ai mis sont bidon, il peut y en avoir qu'une comme il peut y en avoir 25

Si jamais tu peux m'aider, tu me sauvera encore une journée de boulot!!!!!😉😉😉😉😉😉😉
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Ne garder qu'une suite de valeurs... Dur à expliquer en quelques mots ^^

Re,

Le problème est différent mais le principe est très semblable :

Code: 
Sub DerniereInfo()
Dim Ref, n&, Info, d As Object, dd As Object, i&
[A:B].Sort [A1], xlAscending, Header:=xlGuess   'tri sur colonne A
Ref = Application.Transpose(Range("A1:A" & [A65536].End(xlUp).Row + 1)) 'inclut cellule vide
n = UBound(Ref)
Info = Application.Transpose([B1].Resize(n))
Set d = CreateObject("Scripting.Dictionary")
Set dd = CreateObject("Scripting.Dictionary")
For i = 1 To n
  If i < n Then
    If Ref(i + 1) <> Ref(i) Then
      d(Ref(i)) = Ref(i)
      dd(Info(i)) = Info(i)
    End If
  End If
Next
'---restitution---
[D2:E65536].ClearContents
If d.Count Then
  [D2].Resize(d.Count) = Application.Transpose(d.items)
  [E2].Resize(d.Count) = Application.Transpose(dd.items)
End If
End Sub
Fichier joint.

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Ne garder qu'une suite de valeurs... Dur à expliquer en quelques mots ^^

Re,

Ah mais non !

La 2ème collection Scripting.Dictionary (dd) doit être remplacée par un tableau (tablo).

En effet Scripting.Dictionary supprime les doublons, or il y a des doublons dans les informations :

Code: 
Sub DerniereInfo()
Dim Ref, n&, Info, d As Object, i&, tablo$(), j&
[A:B].Sort [A1], xlAscending, Header:=xlGuess   'tri sur colonne A
Ref = Application.Transpose(Range("A1:A" & [A65536].End(xlUp).Row + 1)) 'inclut cellule vide
n = UBound(Ref)
Info = Application.Transpose([B1].Resize(n))
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To n
  If i < n Then
    If Ref(i + 1) <> Ref(i) Then
      d(Ref(i)) = Ref(i)
      ReDim Preserve tablo(j)
      tablo(j) = Info(i)
      j = j + 1
    End If
  End If
Next
'---restitution---
[D2:E65536].ClearContents
If d.Count Then
  [D2].Resize(d.Count) = Application.Transpose(d.items)
  [E2].Resize(d.Count) = Application.Transpose(tablo)
End If
End Sub
Fichier (2).

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

J
  • Question Question
XL 2016 Formule de recherche de valeurs sur deux onglets en entête et en ligne
2
Réponses
22
Affichages
691
Jaykerz
J
D
  • Résolu(e)
Microsoft 365 Assistance pour optimisation d'un code VBA qui ne fonctionne pas comme souhaité
2
Réponses
21
Affichages
1 K
desto
D
L
  • Résolu(e)
Power Query Problème de fusion de données entre deux fichiers Excel sous Power Query
Réponses
8
Affichages
1 K
chris
chris
S
  • Question Question
XL 2019 Fichier de tirage au sort sans doublons avec valeurs en plus
Réponses
1
Affichages
493
sylvanu
sylvanu
V
  • Résolu(e)
Microsoft 365 Barre de recherche : comment rendre éditable le résultat ?
2 3 4
Réponses
52
Affichages
2 K
dysorthographie
dysorthographie
M
  • Question Question
XL 2010 Aide à la suppression d'un produit en double dans un magasin spécifique avec conditions
Réponses
9
Affichages
1 K
Mody200
M
G
  • Question Question
Microsoft 365 Avoir des classeurs maitres et les procédures dans un autre classeur.
2
Réponses
19
Affichages
2 K
GClaire
G
P
  • Résolu(e)
XL 2013 Mise en forme suite à utilisation de UserForm
Réponses
4
Affichages
813
PR.
P
T
  • Résolu(e)
XL 2016 [VBA] Référence en double, additionner les quantités
Réponses
11
Affichages
949
terry08200
T
Usine à gaz
  • Résolu(e)
XL 2021 de la colonne B, ne garder que les communes et cp à mettre en colonne C
Réponses
10
Affichages
663
Usine à gaz
Usine à gaz
S
  • Question Question
XL pour MAC Tableau de gestion de production et de stock
Réponses
14
Affichages
2 K
ScamPs
S
T
  • Question Question
XL 2010 Supprimer les lignes en doubles (multi critères)
2
Réponses
18
Affichages
3 K
oguruma
oguruma
P
  • Question Question
Power Pivot Filtrer une somme en fonction de filtres sur un graphique
Réponses
2
Affichages
574
Pierre111
P
M
  • Question Question
XL 2019 Optimisation de code VBA
2 3
Réponses
33
Affichages
3 K
mmaiga
M
I
  • Résolu(e)
Microsoft 365 Garder dimension des graphes issus d'un lien Excel lors de la MaJ dans PP
Réponses
2
Affichages
622
ilyes4205
I
P
  • Résolu(e)
Microsoft 365 Retourner un autre résultat que le premier (mais non prédéfini) via formule de recherche
Réponses
4
Affichages
569
Pedrolitox
P
E
  • Question Question
XL 2019 Identification des doublons sur la base des attributs de produits
Réponses
3
Affichages
794
ExcelBeginner
E
M
  • Question Question
XL 2019 Optimisation code VBA
Réponses
11
Affichages
1 K
mmaiga
M
L
  • Question Question
XL 2016 Supprimer les doublons (avec 4 colonnes) et ne garder que la ligne la plus ancienne (colonne A)
2 3 4
Réponses
46
Affichages
5 K
ChTi160
ChTi160
B
  • Question Question
XL 2013 Automatiser une formule sur les nouvelles lignes insérées en fonction d'une recherche sur les enregistrements
Réponses
9
Affichages
828
bedley
B
Retour