Recherche dans plusieurs listes sans doublons

[TheLio]

Salut le forum, salut les accros de A1:IV65536.
Ma question est simple (en tout cas pour moi)

Sur différents onglets se trouvent une colonne (B) qui est destinée à l'attribution de fournisseurs pour différents produits (dans la colonne A).

J'aimerai pouvoir récupérer ces données sur un nouvel onglet en évitant les doublons.

Merci le forum, merci les accros de A1:IV65536.

 

[Samantha]

Re : Recherche dans plusieurs listes sans doublons

Bonjour,

Les doublons de quoi de produits ou de fournisseurs ou de couple produit/fournisseur ?

Un petit exemple avec 3 lignes sur 3 onglets et un modèle du résultat souhaité sur le 4ème onglet nous serait d'une grande aide .

Merci de nous aider à t'aider


Sam

 

[TheLio]

Re : Recherche dans plusieurs listes sans doublons

Salut Sam, Merci pour ton implication

Sur l'onglet "Princip", une liste de produits et un fournisseur attribué
à chaque ouverture de nouvel onglet, en le renommant au nom d'un fournisseur je récupère toutes les données relatives à celui-ci.

Ce qui me manque, c'est un onglet ou je puisse récupérer toutes les données de la colonne (B) de l'onglet "Princip" en évitant les doublons.
Ceci me servira d'indicateur pour les nouveaux onglets "fournisseurs" à créer.

Sorry pour les fautes de frappes, mais j'ai l'impression d'avoir les doigts palmés.

@++

TheLio

Trop cool ton flash SMS 😉

 

[Staple1600]

Re : Recherche dans plusieurs listes sans doublons

Bonjour

Voici un essai (qui ne fonctionne pas encore totalement)
(Il ne dédoublonne pas les entetes de colonnes)

Copie les colonnes B de chaque feuille d'un classeur
dans une feuille Recap (créée pour l'occasion)

Si quelqu'un peut me dire le pourquoi (svp). Merci

Sub dtest()
Dim Feu As Worksheet
Dim RecapF As Worksheet
Dim RFdlg As Long
Dim Fdlg As Long

Application.ScreenUpdating = False
Set RecapF = Sheets.Add
RecapF.Name = "Recap"
For Each Feu In ThisWorkbook.Worksheets
If Feu.Name <> RecapF.Name Then
    RFdlg = RecapF.Range("A65536").End(xlUp).Row
    Fdlg = Feu.Range("B65536").End(xlUp).Row
   'Feu.Range("A1:B" & Fdlg).Copy RecapF.Cells(RFdlg + 1, 1)' colonnes A et B
Feu.Range("B1:B" & Fdlg).Copy RecapF.Cells(RFdlg + 1, 1) 'uniquement la colonne B
End If
Next
RecapF.[A1].EntireRow.Delete
'RecapF.Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
      '"C1"), Unique:=True
RecapF.Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
      "B1"), Unique:=True
'RecapF.Columns("B:B").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
      '"D1"), Unique:=True

'RecapF.Columns("A:B").Delete
RecapF.Columns("A:A").Delete
Application.ScreenUpdating = True
End Sub

edit: macro faite avant de voir ton fichier exemple, sur un fichier test
les lignes commentées = modifs pour mieux coller à ta demande (colonne B)

PS: en lisant ton deuxième message, je vois que tu veux déboublonner
la colonne B de la feuille Princip
La macro dtest tombe donc à côté de la question (désolé)

 

[TheLio]

Re : Recherche dans plusieurs listes sans doublons

Salut Staple, dommage car ton code est bien ficelé, je vais voir si je n'arrive pas à en tirer qqch pour mon cas

 

[Staple1600]

Re : Recherche dans plusieurs listes sans doublons

Re

La je suis plus dans le ton, non?

Recopie déboublonnée de colonne B ce la feuille princip dans une nouvelle feuille.

Sub testdedoubl()
Dim NF As Worksheet
Application.ScreenUpdating = False
Set NF = Sheets.Add
Sheets("princip").Columns("B:B").AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=NF.Range( _
      "A1"), Unique:=True
Application.ScreenUpdating = True
End Sub

Ce qui est marrant c'est que la macro laisse une ligne vide
(donc considère N lignes vides comme des doublons)

 

[kiki29]

Re : Recherche dans plusieurs listes sans doublons

via une Collection

Public Sub DoublonsOuPas()
Dim Coll As New Collection
Dim Cell As Range, Plage As Range
Dim iLAstRow As Long
Dim i As Long

    With ShPrincip
        iLAstRow = .Range("B65536").End(xlUp).Row
        Set Plage = .Range("B2:B" & iLAstRow)
    End With
    
    On Error Resume Next
    For Each Cell In Plage
        If Cell <> "" Then
            Coll.Add Cell, CStr(Cell)
            If Err = 457 Then
                Err.Clear
            End If
        End If
    Next Cell
    
    ShVierge.UsedRange.Offset(1).Clear

    For i = 1 To Coll.Count
        ShVierge.Cells(i + 1, 2) = Coll(i)
    Next i
End Sub

 

[TheLio]

Re : Recherche dans plusieurs listes sans doublons

Ok Merci Staple,
je devrais m'en sortir avec celle-là.

et désolé kiki, mais ya un truc qui manque dans tes lignes, je n'ai pas vraiment eu le temps de regarder quoi, mais ça bug.

Merci le forum, merci les accros de A1:IV65536.

et à tout bientôt pour de nouvelle aventures de L1C1
@++

The Lio

 

[kiki29]

Re : Recherche dans plusieurs listes sans doublons

Désolé mais si tu l'inclus dans le code que tu as fourni 20071aout.zip
c'est malheureusement pour toi ton code qui est en cause
effectivement il faut comprendre que Sheets("princip") a été renommée en ShPrincip propriété (name) sous VBE etc
sans compter une gestion évenementielle curieuse , une déclaration de variables qui ne ressemble à rien

 

[kiki29]

Re : Recherche dans plusieurs listes sans doublons

pgm modifié , procédures Worksheet_Activate supprimées