Concaténer intelligement des valeurs contenues dans un tableau

Résolu
danibounn Messages postés 7 Statut Membre -  
danibounn Messages postés 7 Statut Membre -
Bonjour à tous,
J'utilise ce forum depuis des années ce site très bien fait, et j'ai toujours réussi à trouver réponse à mes questions sans avoir besoin de m'enregistrer en recherchant soigneusement sur le forum, mais cette fois-ci je suis bloqué depuis trop longtemps sans trouver un problème similaire, alors je saute le pas...

Voici mon problème, j'ai des CONTENEURS composés de nombreuses PALETTES.
J'ai une page Sheets("FT") où chaque ligne est une palette.
Dans ma page active Sheets("WEEKLY"), chaque ligne est un conteneur, et je souhaite concaténer pour chaque conteneur le poids total des palettes ainsi que la liste des barcodes mais sans doublon (dans le cas où il y'a plusieurs palettes de même type dans un conteneur...)

Je crée 2 tableaux qui récupèrent le POIDS total tabkg() et les BARCODES tabbcodes().
Pour le poids total ça marche parfaitement, malheureusement j'ai tout essayé pour les barcodes impossible de trouver. J'arrive à peine à afficher un seul barcode (code ci-dessous). J'ai mis des espions sur tabbcodes pour surveiller en pas à pas et les barcodes s'enregistrent pourtant parfaitement. C'est donc surtout un problème de transcription et de tri...

Je vous remercie par avance pour votre aide et vos suggestions.
Ci-dessous mon code en totalité :

Sub BARCODESKG()

Dim lgn As Currency
Dim i As Currency
Dim k As Currency
Dim u As Currency
Dim finpal As Long
Dim fincont As Long
Dim container As String
Dim client As String
finpal = Sheets("FT").Range("A3").End(xlDown).Row
fincont = Sheets("WEEKLY").Range("B3").End(xlDown).Row
i = 0
k = 0
lgn = 0

'--------------- SELECTION DU CONTAINER ---------------

For u = 3 To fincont - 3

container = Cells(u, 9)
client = Cells(u, 6)

i = 0
k = 0
lgn = 0

'--------------- RECHERCHE NOMBRE DE PALETTES PAR CONTAINER ---------------

For lgn = 3 To finpal
If Sheets("FT").Cells(lgn, 6).Value = container And Sheets("FT").Cells(lgn, 7).Value = client Then
k = k + 1
End If
Next lgn

'--------------- RECUPERATION DES DONNEES ---------------

Dim tabkg()
Dim tabbcodes() As String
ReDim tabkg(k - 1, 1)
ReDim tabbcodes(k - 1, 1) As String
i = -1

For lgn = 3 To finpal
If Sheets("FT").Cells(lgn, 6).Value = container And Sheets("FT").Cells(lgn, 7).Value = client Then
i = i + 1
tabkg(i, 1) = Sheets("FT").Cells(lgn, 19)
tabbcodes(i, 1) = Sheets("FT").Cells(lgn, 11)
End If
Next lgn

'--------------- RESTITUTION KG ---------------

Dim p As Integer
Dim TOTAL As Long

For p = 0 To UBound(tabkg)
TOTAL = TOTAL + tabkg(p, 1)
Next p

Cells(u, 12) = TOTAL
TOTAL = 0

'--------------- RESTITUTION BARCODES ---------------

Cells(u, 14) = tabbcodes(1, 1)

Next u

End Sub

7 réponses

  1.
    f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Bonjour,

    J"sais pas si c'est intelligent, a vous de rendre compte

    votre code quelque peu modifie: 

    Sub BARCODESKG()
        Dim lgn As Currency
        Dim u As Currency
        Dim finpal As Long
        Dim fincont As Long
        Dim container As String
        Dim client As String
        Dim TOTAL As Long

        Dim Dico_CaB As Object
        Dim TCaB        'recupe CaB sans doublons
        Dim STCab       'liste CaB
        Application.ScreenUpdating = False

        finpal = Sheets("FT").Range("A3").End(xlDown).Row
        fincont = Sheets("WEEKLY").Range("B3").End(xlDown).Row
    '--------------- SELECTION DU CONTAINER ---------------
        With Worksheets("WEEKLY")
            For u = 3 To fincont - 3
                container = .Cells(u, 9)
                client = .Cells(u, 6)
    '--------------- RECHERCHE NOMBRE DE PALETTES PAR CONTAINER & DONNEES ---------------
                TOTAL = 0
                k = -1
                Set Dico_CaB = CreateObject("scripting.dictionary")
                With Sheets("FT")
                    For lgn = 3 To finpal
                        If .Cells(lgn, 6).Value = container And .Cells(lgn, 7).Value = client Then
                            TOTAL = TOTAL + .Cells(lgn, 19)
                            cleCaB = .Cells(lgn, 11)
                            If Not Dico_CaB.exists(cleCaB) Then
                                Dico_CaB.Add cleCaB, ""
                            End If
                        End If
                    Next lgn
                End With
    '--------------- RESTITUTION KG ---------------
                .Cells(u, 12) = TOTAL
    '--------------- RESTITUTION BARCODES ---------------
                TCaB = Dico_CaB.keys
                STCab = Join(TCaB, ";")
                .Cells(u, 14) = STCab
                Set Dico_CaB = Nothing
            Next u
        End With
        Application.ScreenUpdating = True
    End Sub
    1
  2. danibounn Messages postés 7 Statut Membre
     
    Extraordinaire, ça marche à la perfection !!!
    Grand bravo à vous, et milles remerciements.......

    Puis-je pousser le bouchon jusqu'à vous demander si il existe une possibilité de classer les Barcodes dans l'ordre croissant ? :)

    Dans tous les cas ça va déjà me sauver un temps fou (l'an dernier j'ai embauché un employé à plein temps en haute saison qui filtrait des tableaux croisés dynamiques à longueur de journée pour remplir ce fichier...)
    0
  3. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Re,

    classer les Barcodes dans l'ordre croissant ? :) Pouvez-vous donner des exemples de Codes a Barre (tout numerique ou alphanumerique ???)
    0
  4. danibounn Messages postés 7 Statut Membre
     
    Merci pour votre réactivité !
    Oui bien sûr,
    Voilà par exemple un extrait de ce que m'a fournit votre code sur une vingtaine de conteneurs (j'ai juste remplacé les ";" par des espaces entre les barcodes).

    J'aimerais les classer simplement par ordre croissant, c'est une suite de chiffres donc ça devrait être possible, il n'y a jamais de lettres...

    20901027 20901028
    20900006 20900002 20901032 20901001 20901022 20901007
    10003005 10003027 10003028 10003029
    10003005 10003007 10003009 10003008 10003006 10003004
    10003002
    10003002
    10003004 10003008 10003003
    10003007 10003005 10003006
    10003006 10003004
    10003006 10003007 10003021 10003005
    10003002
    10003005
    10003005
    10003004 10003008 10003003
    10003006 10003004
    10003006 10003007 10003009
    40305042 40305028 40305033
    20901032 20900006 20901001 20901022 20900002 20901020 20900005
    20908002 20908001 20900003 20900005 20900002 20900006
    20905036 20905045 20905048 20905007 20905017 20905019 20905021 20905022 20905024 20905023

    Puisqu'il vaut mieux apprendre à pécher que recevoir un poisson :), pourriez-vous me dire à quoi correspond "Dico_Cab" je ne connaissais pas du tout, j'ai l'impression qu'il s'agit d'une table en plus puissant (puisqu'elle peut associer une "clé" et donc sélectionner ou non des valeurs...) mais je ne connaissais pas du tout ?!

    Y'a t-il un endroit sur internet où je peux me documenter sur cette fonction ?

    MERCI BEAUCOUP !
    0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Re,

    objet dictionary, un site au hasard: http://www.excelabo.net/excel/scripting_dictionary

    pour le classement, je regarde la chose
    0
  7. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Re,

    autre site : http://boisgontierjacques.free.fr/pages_site/Dictionnaire.htm

    le sub tri vient de ce site.

    avec CaB tries: 

    Sub BARCODESKG()
        Dim lgn As Currency
        Dim u As Currency
        Dim finpal As Long
        Dim fincont As Long
        Dim container As String
        Dim client As String
        Dim TOTAL As Long

        Dim Dico_CaB As Object
        'Dim TCaB()        'recupe CaB sans doublons
        Dim STCab       'liste CaB
        Application.ScreenUpdating = False

        finpal = Sheets("FT").Range("A3").End(xlDown).Row
        fincont = Sheets("WEEKLY").Range("B3").End(xlDown).Row
    '--------------- SELECTION DU CONTAINER ---------------
        With Worksheets("WEEKLY")
            For u = 3 To fincont - 3
                container = .Cells(u, 9)
                client = .Cells(u, 6)
    '--------------- RECHERCHE NOMBRE DE PALETTES PAR CONTAINER & DONNEES ---------------
                TOTAL = 0
                k = -1
                Set Dico_CaB = CreateObject("scripting.dictionary")
                With Sheets("FT")
                    For lgn = 3 To finpal
                        If .Cells(lgn, 6).Value = container And .Cells(lgn, 7).Value = client Then
                            TOTAL = TOTAL + .Cells(lgn, 19)
                            cleCaB = .Cells(lgn, 11)
                            If Not Dico_CaB.exists(cleCaB) Then
                                Dico_CaB.Add cleCaB, ""
                            End If
                        End If
                    Next lgn
                End With
    '--------------- RESTITUTION KG ---------------
                .Cells(u, 12) = TOTAL
    '--------------- RESTITUTION BARCODES ---------------
                TCaB = Dico_CaB.keys
                
                    Call tri(TCaB, LBound(TCaB), UBound(TCaB))
                    
                STCab = Join(TCaB, ";")
                .Cells(u, 14) = STCab
                Set Dico_CaB = Nothing
            Next u
        End With
        Application.ScreenUpdating = True
    End Sub

    Sub tri(a, gauc, droi) ' Quick sort
      ref = a((gauc + droi) \ 2)
      g = gauc: d = droi
      Do
        Do While a(g) < ref: g = g + 1: Loop
        Do While ref < a(d): d = d - 1: Loop
        If g <= d Then
           temp = a(g): a(g) = a(d): a(d) = temp
           g = g + 1: d = d - 1
        End If
      Loop While g <= d
      If g < droi Then Call tri(a, g, droi)
      If gauc < d Then Call tri(a, gauc, d)
    End Sub
    0
  8. danibounn Messages postés 7 Statut Membre
     
    ça marche à merveille, merci pour votre temps et votre aide précieuse.
    0

Discussions similaires

garder constant des calculs
jack2125 -
PHILOU10120 -

4 réponses
CALCULS
smart19 -
Dracknard -

4 réponses
Tableau croisé dynamique - absence de certaines données
crazyrider71 -
Hana -

4 réponses