Dictionnary Array affichage

Bonjour,

J'ai un problème au niveau de mon code j'ai beau le triturer dans tout les sens je ne comprends pas ce qui cloche, si quelqu'un peut me donner un peu de soutien ca serait fantastique.

Pour info sur le fichier : l'objectif est de réaliser une liste de matériel en plusieurs étape par un utilisateur.

Pour jouer avec le fichier :

1) appuyer sur clear choisir nombre de travée et autre

2) appuyer sur étape 1, choisir taille des travées dans les cases crées

3) appuyer sur étape 2

4) appuyer sur étape 3

et problème à cette étape.

Il y a donc un array avec des informations au sujet du matériel qui est réalisé, il est transposé dans un dictionnaire pour regrouper les valeurs puis afficher sur la page. Ensuite une boucle fort compare les longueurs (820,1060 etc.) pour retrouver les références correspondantes dans une base de donnée avec une boucle for. C'est donc justement sur cette dernière partie qu'il y a un souci.

Sur le fichier je voudrais avoir les références correspondantes mais je ne sais pas pourquoi le code ce bloc.

Le problème se situe dans le module M03_LongCanne.

La partie du code correspondant est la suivante :

 Sub dico_tubes()

Dim n As Integer
Set dicotubes = CreateObject("Scripting.Dictionary")
With Worksheets("User")
    For Each c In tabtube
        dicotubes(c) = dicotubes(c) + 1
    Next c
    derniereL = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row: derniereL = derniereL + 2
    .Cells(derniereL, 4).Resize(dicotubes.Count, 2) = Application.Transpose(Array(dicotubes.keys, dicotubes.items))
    .Cells(derniereL - 1, 4).Sort Key1:=.Cells(derniereL, 4), Order1:=xlAscending, Header:=xlYes

    z = 0
    For n = 1 To 300
        If Range("Type_de_canne") = Sheets("Cannes_ref").Cells(n, 1) And Sheets("user").Cells(derniereL + z, 4) = Sheets("Cannes_ref").Cells(n, 2) Then
            ReDim Preserve mattubes(z): mattubes(z) = Sheets("Cannes_ref").Cells(n, 4)
            z = z + 1
        End If
    Next n

Merci à tous pour votre aide !

Bonjour,

Un essai ...

Si j'ai bien compris ton souci > il y a décalage entre la colonne C et D pour la première section "Tubes pour cannes de descentes" ...

Macro "dico_tubes" effectivement >

Changer :

.Cells(derniereL - 1, 4).Sort Key1:=.Cells(derniereL, 4), Order1:=xlAscending, Header:=xlYes

pour :

.Cells(derniereL, 4).Sort Key1:=.Cells(derniereL, 4), Order1:=xlAscending, Header:=xlYes

Puis ...

Changer :

.Range(Cells(derniereL, 3), Cells(derniereL + z , 3)) = mattubes

pour

.Range(Cells(derniereL, 3), Cells(derniereL + z -1, 3)) = mattubes

ric

Bonjour Ric,

Merci de ton aide. Alors oui mais le problème est surtout au niveau de la référence FB7510 qui devrait être différente pour chaque longueur, quand je cherche dans ma tab avec la boucle for pour connaitre les réf des longueur c'est comme ci la boucle se bloquait au FB7510 alors que les longueurs changent.

Bonjour,

Il manque "transpose" pour "mattubes ...

Modifie la dernière ligne de "dico_tubes" :

.Range(Cells(derniereL, 3), Cells(derniereL + z - 1, 3)) = mattubes

pour celle-ci :

.Range(Cells(derniereL, 3), Cells(derniereL + z - 1, 3)) = Application.Transpose(mattubes)

ric

Bonjour Ric,

C'est absolument merveilleux. Ce que je dois apprendre c'est à chaque fois que je colle un tableau je dois utilisé l’application transpose, je ne comprends pas pourquoi ca ne marchait pas finalement.

Je me permets de te poser une toute dernière question lié à ce code puisque j'ai une dernière chose qui ne marche pas.

Ici : j'ai tout les piquages ouvert, c'est magique tout sort parfaitement, aucun doublons les codes sont bon c'est génial

mais quand je ferme un piquage : Là c'est la débandade ...

Pourtant j'ai bien écris :

If Mid$(s, pg, 1) = "1" Then
Cells(p, pg + 3) = .Cells(j, k) & "  "
tabtube(u, 0) = .Cells(j, k): u = u + 1
End If

Donc seulement si il y a présence de 1.

Si tu vois quelque chose je suis à l'écoute puisque je cherche sans trouver.

1000 merci pour l'aide.

Fichier joint :

Bonjour,

Un essai ...

ric