Récupérer d'un tableau valeur sans doublon

cathodique

XLDnaute Barbatruc
Bonsoir,

Ne maitrisant pas très bien le dictionnaire, je trouve des difficultés à parvenir au bout de mon raisonnement.

Je m'explique, sur la feuille BD (col 3, 4 et 5) on trouve les valeurs de la feuille Test F1 correspond à col 3, C2correspond à col 4 et C3 correspond à col 5. sur la feuille BD on les retrouve plusieurs fois.

Alors je voudrais faire un test sur la présence ou non sur la feuille BD par rapport aux cellules F1,C2et C3.

je ne veux pas passer par une colonne intermédiaire. Mon idée est d'utilisé un tableau et un dictionnaire.

J'ai récupéré les données de la feuille BD dans un tableau les valeurs correspondant à F1,C2 et C3 et j'ai concaténé dans un tableau. mon souci est comment récupéré de ce dernier tableau les valeurs sans doublons.

Normalement, il n'en restera qu'une afin que je puisse la comparer à la concaténation de F1,C2 et C3.
Code:
'Option Explicit
Sub Test_Critères()
Dim fo As Worksheet, bd As Worksheet, fg As Worksheet
Dim LastLig As Long
Dim Tb, RES(), Ret(), mondico
Dim Val1 As String, Val2 As String, Val3 As String
Dim i As Long, j As Long
'''''''''''''''''''''''''''''''''''''''''''
Set bd = Sheets("BD") 'définit l'onglet bd
Set fo = Sheets("Feuil1")       'juste pour voir resultat
Set fg = Sheets("test") 'où sont les paramètres
'==============================================================================
Application.ScreenUpdating = False
'Dans la variable tableau Tb on récupère toutes les données de la feuille BD
With bd
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    Tb = .Range("C2:E" & LastLig)
End With
     
     Val1 = fg.Range("F1")        'date
     Val2 = fg.Range("C2")        'size1
     Val3 = fg.Range("C3")        'size
    'on parcours le tableau Tb et si la ligne correspond aux 3 critères
    For i = 1 To LastLig - 1
        '
        If Tb(i, 1) = Val1 And Tb(i, 2) = Val2 And Tb(i, 3) = Val3 Then
            'on incrémente le compteur j
            j = j + 1
            'On redimensionne notre tableau Resultat Res
            ReDim Preserve RES(1 To 4, 1 To j)
            'Le compteur est inscrit en 1ère ligne
            'on fait une petite boucle
            RES(1, j) = Tb(i, 1)    'date
            RES(2, j) = Tb(i, 2)    'size1
            RES(3, j) = Tb(i, 3)   'size2
            RES(4, j) = Tb(i, 1) & Tb(i, 2) & Tb(i, 3)
        End If
        
    Next i
    
    '''''ces 3 lignes juste pour avoir une idée du résultat''''''''''
    LastLig = o.Cells(o.Rows.Count, 1).End(xlUp).Row
    If LastLig > 1 Then o.Range("A2:L" & LastLig).Clear
    If j > 0 Then o.Range("A2").Resize(j, 4) = Application.Transpose(RES)
   ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub
En vous remerciant par avance.
Mon objectif est faire un test en mémoire, extraire du tableau RES(4,J) valeur sans doublon ou bien vérifier que la concaténation de F1,C2 et C2 existe dans le dictionnaire pour effectuer tel ou tel autre procédure.
 

Bebere

XLDnaute Barbatruc
Re : Récupérer d'un tableau valeur sans doublon

bonjour Cathodique
pas facile sans fichier pour tester
tu peux le faire en une fois,1ère partie(boucle i) indexe le tableau
2ème partie(boucle items) restitue
pas déclaré les variables

Code:
Sub RechercheDicoVille()

    Set mondico = CreateObject("scripting.dictionary")
    With bd
        LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
        Tb = .Range("C2:E" & LastLig)
    End With

    Val1 = fg.Range("F1")        'date
    Val2 = fg.Range("C2")        'size1
    Val3 = fg.Range("C3")        'size
    For i = 1 To UBound(Tb, 1)
if Tb(i, 1) & Tb(i, 2) & Tb(i, 3)=Val1 & Val2 & Val3 Then
        CléBase = Tb(i, 1) & Tb(i, 2) & Tb(i, 3)
        Clé = CléBase
        indice = 1
        Do While mondico.exists(Clé)
            Clé = CléBase & indice
            indice = indice + 1
        Loop
        mondico(Clé) = i
End If
    Next i
    For Each Item In mondico.items
        CléBase = Item
        Clé = CléBase
        indice = 1
        Do While mondico.exists(Clé)
            ligne = mondico(Clé)
            j = j + 1
            'On redimensionne notre tableau Resultat Res
            ReDim Preserve RES(1 To 4, 1 To j)
            'Le compteur est inscrit en 1ère ligne
            'on fait une petite boucle
            RES(1, j) = Tb(ligne, 1)    'date
            RES(2, j) = Tb(ligne, 2)    'size1
            RES(3, j) = Tb(ligne, 3)   'size2
            RES(4, j) = Tb(ligne, 1) & Tb(ligne, 2) & Tb(ligne, 3)
            Clé = CléBase & indice
            indice = indice + 1
        Loop

    Next Item

End Sub
 

cathodique

XLDnaute Barbatruc
Re : Récupérer d'un tableau valeur sans doublon

Bonjour Bebere,

Je te remercie pour ton retour, quant au fichier toutes mes excuses j'ai complètement oublié.

J'ai bien trouvé l'exemple ici, j'étais dessus mais j'avoue ne pas avoir réussi.

Je voudrais donc en cliquant sur le bouton test déclencher ta macro pour vérifier la présence dans la BD d'au moins 1 ligne qui correspond aux 3 critères. Si c'est le cas, on sort de la procédure sinon elle se poursuit.

dans le genre
Code:
Private Sub CommandButton1_Click()
 
 'Call RechercheDicoVille
If trouver = True Then
Exit Sub
Else
'appeler la macroxx
MsgBox "non trouvé!"
End Sub

J'ai repris tous les codes de la discussion du lien mais je ne suis pas parvenu à un résultat probant.

Je te remercie beaucoup pour ton aide. Je joins un fichier, j'y ai mis une combinaison pour tester.

Bon week-end.
 

Pièces jointes

  • TROUVE - Copie.xlsm
    193.1 KB · Affichages: 47

cathodique

XLDnaute Barbatruc
Re : Récupérer d'un tableau valeur sans doublon

Je reviens pour vous informer que j'obtiens un résultat en utilisant une colonne intermédiaire avec le code ci-dessous.

Mais je ne veux pas utiliser cette solution pour 2 raisons: 1- je ne dois pas toucher à la structure de la BD et 2- pour apprendre un peu plus sur les tableaux et dictionnaire.
Code:
Sub Recherche_avec_insertion_colonne()
Dim fo As Worksheet, bd As Worksheet, fg As Worksheet
Dim LastLig As Long, critere As String, c As Range
Dim i As Long, j As Long
'''''''''''''''''''''''''''''''''''''''''''
Set bd = Sheets("BD") 'définit l'onglet bd
Set fo = Sheets("Feuil1")       'juste pour voir resultat
Set fg = Sheets("test") 'où sont les paramètresDim RES()

    With bd
        LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To LastLig
        .Cells(i, 28) = .Cells(i, 3) & .Cells(i, 4) & .Cells(i, 5)
        Next i
    End With

critere = fg.Range("F1") & fg.Range("C2") & fg.Range("C3")
    
    Set c = BD.[AB:AB].Find(critere, LookIn:=xlValues)

  If c Is Nothing Then
  MsgBox "Non trouvé, on continue!"
  Else
   
  End If
    bd.Columns(28).EntireColumn.Delete
  End Sub
Je n'arrive pas exploiter la solution que tu me proposes. Je joins un autre fichier, vous comprendrez mieux le résultat escompté.

En vous remerciant.
 

Pièces jointes

  • Trouve2.xlsm
    198.8 KB · Affichages: 41
  • Trouve2.xlsm
    198.8 KB · Affichages: 58
  • Trouve2.xlsm
    198.8 KB · Affichages: 54

cathodique

XLDnaute Barbatruc
Re : Récupérer d'un tableau valeur sans doublon

Bonjour Bebere,

Je te remercie beaucoup pour tout le travail que tu as fait pour me venir en aide. J'ai bien activé les macros à l'ouverture du fichier mais l'userform ne s'ouvre pas. J'ai vu le code du commandButton, et il y a userform1.show, mais quand je clique rien ne se déclenche même pas une erreur.

Enfin, je te remercie beaucoup mais ce n'est pas ce que je voulais car vois-tu j'ai dèjà un userform dans mon fichier original.

J'ai sans doute mal exprimé mon besoin. Voilà, dans mon fichier, sur la feuille test, je fais appel à un userform et suivant mes selections j'importe d'une bd1, un canevas que je renseigne. une fois renseigné, je clique sur un bouton qui transfert toutes ces données sur la feuille BD. C'est à ce niveau que réside mon souci. En effet, à chaque clique les données sont transférées, c'est ce que je voudrais éviter. J'y suis parvenu en utilisant une colonne intermédiaire où sont concaténées les colonnes D, C et E (ces données sont les cellules F1, C2 et C3 de la feuille test) et j'ai utilisé la fonction Find.

Comme je ne dois pas toucher à la structure de la BD, je me suis dis que l'on pouvait faire la même chose en mémoire et j'ai pensé aux tableaux que je maitrise pas beaucoup.

Alors mon idée était de récupérer les 3 colonnes dans un tableau, puis les concaténer dans un autre tableau, puis utiliser un dictionnaire pour extraire de ce dernier tableau les concaténations sans doublons et enfin vérifier que la concaténation des cellules F1&C2&C3 existe dans le dictionnaire. Si elle existe on quitte la procédure sinon on effectue le transfert.

ça devrait être réalisable, mais j'avoue que mes connaissances du vba ne sont très poussées pour y parvenir tout seul.

Dans mon premier post, j'ai fait un début dans le tableau RES(4,j), il représente la concaténation des 3 colonnes. Est-ce qu'on pourrait extraire de RES(4,j) les données sans doublons? Est-ce qu'on peut utiliser la fonction Find sur des tableaux?

Encore merci et bon Dimanche.
 

job75

XLDnaute Barbatruc
Re : Récupérer d'un tableau valeur sans doublon

Bonjour cathodique, Bebere,

Vous avez l'art, cathodique, de bien compliquer les choses.

D'après ce que je comprends il s'agit d'un filtrage sans doublon :

Code:
Sub Filtrer()
Dim dest As Range, critere$, t, d As Object, i, x$, n&
With Sheets("TEST")
  Set dest = .[B8] 'pour la restitution
  critere = .[F1] & Chr(1) & .[C2] & Chr(1) & .[C3]
End With
With Sheets("BD")
  t = .Range("C2:E" & .Range("C" & .Rows.Count).End(xlUp).Row)
End With
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(t)
  x = t(i, 1) & Chr(1) & t(i, 2) & Chr(1) & t(i, 3)
  If x <> critere And Not d.exists(x) Then
    d(x) = ""
    n = n + 1
    t(n, 1) = t(i, 1): t(n, 2) = t(i, 2): t(n, 3) = t(i, 3)
  End If
Next
'---restitution---
If n Then
  dest.Resize(n, 3) = t
  dest.Resize(n, 3).Sort dest, xlAscending, Header:=xlNo 'tri facultatif sur les dates
End If
dest.Offset(n).Resize(dest.Parent.Rows.Count - n - dest.Row + 1, 3) = ""
End Sub
Fichier joint, si ce n'est pas ce que vous voulez expliquez plus clairement (et surtout plus simplement).

A+
 

Pièces jointes

  • Trouve(1).xls
    780 KB · Affichages: 30
  • Trouve(1).xls
    780 KB · Affichages: 49
  • Trouve(1).xls
    780 KB · Affichages: 31
Dernière édition:

cathodique

XLDnaute Barbatruc
Re : Récupérer d'un tableau valeur sans doublon

Bonjour Job75,
Vous avez l'art, cathodique, de bien compliquer les choses.
Fort possible mon cher Job75
D'après ce que je comprends il s'agit d'un filtrage sans doublon
Tu as peut-être raison, mes connaissances sont assez basiques et de surplus je ne code que pour passer le temps.

Cependant, une question as-tu vu le code de mon post#4? j'ai utilisé une colonne intermédiaire (dernière colonne de la BD) où j'ai concaténé les 3 colonnes et effectué une recherche des critères. Elle fonctionne bien.

Je voudrais parvenir au même résultat en mémoire en utilisant les tableaux. je ne suis très fort en vba et ne connais pas toutes les subtilités et astuces du codage, mais d'après ce que j'ai pu lire sur le forum et le net: "on peut pratiquement tout faire en vba".

Pour faire simple, je voudrais rechercher sheets("test").range("F1")&sheets("test").range("C2")&sheets("test").range("C3") dans un tableau qui sera la concaténation des colonnes C,D et E de la feuille BD.

C'est juste un test que je veux faire, je ne veux rien récupérer du tout. Si les critères de la feuille test sont dans la feuille BD, la procédure de transfert ne s’exécute pas.

Merci beaucoup, je pensais que c'était facile à refaire avec les tableaux à moins que mon raisonnement ne soit faux ou bien que mon esprit soit tordu.

Bon dimanche à tous.
 

cathodique

XLDnaute Barbatruc
Re : Récupérer d'un tableau valeur sans doublon

Bonjour Bebere, nos posts se sont croisés. Sincèrement, je pensais que mes explications étaient claires. Je constate à mon désarroi que ce n'est pas le cas, à moins que comme me l'a dit Job75, je me complique l'existence pour rien.

Je ne suis pas très à l'aise en vba, je pensais que concaténer 3 colonnes dans un tableau, ne pas garder les doublons (pour que la recherche soit plus rapide), et rechercher dans ce tableau final les 3 cellules concaténées, seraient facile pour des initiés. Mais en fin de compte, je me rends compte que je me suis mal expliqué.

Merci pour ton intérêt à mon souci.

Bon dimanche.
 

laetitia90

XLDnaute Barbatruc
Re : Récupérer d'un tableau valeur sans doublon

bonjour cathodique:),Bebere:),job:)

comme je comprends

Code:
Sub es()
 Dim m As Object, t(), i As Long, z, w
 Application.ScreenUpdating = 0
 Set m = CreateObject("Scripting.Dictionary")
 t = Feuil2.Range("c2:e" & Feuil2.Cells(Rows.Count, 1).End(3).Row)
     Val1 = Feuil1.Range("F1")
    Val2 = Feuil1.Range("C2")
    Val3 = Feuil1.Range("C3")
 w = Val1 & Val2 & Val3
 For i = 1 To UBound(t)
 z = t(i, 1) & t(i, 2) & t(i, 3)
 If Not m.Exists(z) And z = w Then
 m.Add z, z
   MsgBox "trouvé ligne ...   " & i + 1: Exit For
 Else
 'code transfert
 End If
 Next i
End Sub
 

job75

XLDnaute Barbatruc
Re : Récupérer d'un tableau valeur sans doublon

Re,

Je voudrais parvenir au même résultat en mémoire en utilisant les tableaux

Si le but c'est d'obtenir un tableau VBA des résultats :

Code:
Sub Filtrer()
Dim dest As Range, critere$, t, d As Object, i, x$, n&, resultat(), a, s
With Sheets("TEST")
  Set dest = .[B8] 'facultatif, pour la restitution
  critere = .[F1].Value2 & Chr(1) & .[C2] & Chr(1) & .[C3]
End With
With Sheets("BD")
  t = .Range("C2:E" & .Range("C" & .Rows.Count).End(xlUp).Row).Value2
End With
'---filtrage sans doublon---
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(t)
  x = t(i, 1) & Chr(1) & t(i, 2) & Chr(1) & t(i, 3)
  If x <> critere Then d(x) = x
Next
n = d.Count
If n Then
  '---création du tableau VBA des résultats---
  ReDim resultat(1 To n, 1 To 3)
  a = d.items
  For i = 1 To n
    s = Split(a(i - 1), Chr(1))
    resultat(i, 1) = s(0): resultat(i, 2) = s(1): resultat(i, 3) = s(2)
  Next
  '--restitution dans la feuille (facultative)---
  dest.Resize(n, 3) = resultat
  dest.Resize(n, 3).Sort dest, xlAscending, Header:=xlNo 'tri facultatif sur les dates
End If
'---RAZ en-dessous (facultative)---
dest.Offset(n).Resize(dest.Parent.Rows.Count - n - dest.Row + 1, 3) = ""
End Sub
Fichier (2).

Edit 1 : hello chère Laetitia :)

Edit 2 : je n'avais pas fait attention, il faut ici utiliser .Value2 à cause des dates.

A+
 

Pièces jointes

  • Trouve(2).xls
    781.5 KB · Affichages: 36
  • Trouve(2).xls
    781.5 KB · Affichages: 50
  • Trouve(2).xls
    781.5 KB · Affichages: 43
Dernière édition:

cathodique

XLDnaute Barbatruc
[RESOLU]: Récupérer d'un tableau valeur sans doublon

Bonjour,

@ laetitia90 BRAVOOOOOOOOOOOOOOOO! tu es une REINE en majuscule. c'est ce que je souhaitais obtenir. Toute ma reconnaissance.

@Job75 Franchement, je te remercie pour ton aide, j'apprécie vraiment mais je n'avais pas besoin de lister les combinaisons présentes dans ma BD. merci.

Laetitia a très bien compris mon problème. J'avoue que je n'aurai jamais réussi tout seul. Je me serai contenté de mon premier code.

Mon souci est résolu. Merci à vous tous, bonne fin d'après-midi.
 

job75

XLDnaute Barbatruc
Re : Récupérer d'un tableau valeur sans doublon

Re,

Bon je n'avais pas compris, mais puisque c'est comme ça il n'y a aucun intérêt à éliminer les doublons.

Le code de Laetitia simplifié :

Code:
Sub es()
Dim t, w$, i&
t = Feuil2.Range("C1:E" & Feuil2.Cells(Rows.Count, 1).End(3).Row)
w = Feuil1.Range("F1") & Feuil1.Range("C2") & Feuil1.Range("C3")
For i = 1 To UBound(t)
  If t(i, 1) & t(i, 2) & t(i, 3) = w Then _
    MsgBox "trouvé ligne " & i: Exit Sub
Next
'code transfert
End Sub
A+
 

Discussions similaires

Statistiques des forums

Discussions
312 190
Messages
2 086 040
Membres
103 105
dernier inscrit
fofana