Vba array vers range dans boucle

Bonsoir Didoch54000,

Je pense qu'en fait fait il te retourne toujours la valeur de la dernière cellule de la colonne "B".
C'est dû à la fonction "Function retournLibelle".
En fait, dans cette fonction, d'abord tu boucles sur toutes les lignes de la colonne "B", mais en plus, tu ne lui demande que de te renvoyer la dernière valeur trouvée.
Ce que je n'arrive pas à comprendre, c'est que la taille du tableau est variable, mais que tu dispose les éléments de ce tableau dans un rectangle de taille fixe => (126/4) sur (48/6) .. As-tu une raison particulière pour faire de la sorte ?

Bonjour,

a chaque pas de la boucle, tu appelles l'ensemble de la variable tableau "TbloLibel"
donc la plage sélectionnée aura toujours la 1° ou dernière valeur de TbloLibel (pour inverser je serais plutôt aller de Ubound à Lbound)

il faudrait peut-^tre que TbloLibel exporte un nbre de données égale à la surface de ta plage. fais attention au décalage car TbloLibel est en base zéro

mais je vois mal ce que tu veux faire ( tu parles de tri, mais...)

pour joindre une pièce
mettre le classeur sans données confidentielles en pièce jointe sur
https://www.cjoint.com/
puis copier l'adresse du lien et la coller dans le message de réponse

mais explique tout clairement surtout ta page "étiquette"

dans l'attente

Bonsoir à tous,

D'ores et déjà un grand remerciement à vous tous j'ai uploadé le fichier a cet emplacement : https://www.cjoint.com/?0JEwaGM7cbP

J'ai plus ou moins trouvé mon probleme de boucle :

Sub Bouton5_Clic() 
    Dim DernLigne As Long 
    DernLigne = Range("A" & Rows.Count).End(xlUp).Row 
    'traitementListes 
    RangeArray DernLigne 
    
End Sub 


Sub RangeArray(DrLgn As Long) 
    'Declaration du tableau taille dynamique et redimension du tableau 
    Dim TbloLibel() As Variant 
With Sheets("Dotation").Range("A2:E" & DrLgn) 
    ReDim TbloLibel(.Rows.Count, .Columns.Count) 
    'Affecte les valeurs au tableau 
    TbloLibel = .Value 
    'MsgBox UBound(TbloLibel) 

End With 

Dim x As Integer, y As Integer, i As Integer, ia As Integer 
Dim Onglet As Worksheet 
Dim PlageTravail As Range 
     
    Set Onglet = Worksheets("etiquette pt") 
    Onglet.Select 

'Remplir la case 'libellé' 
ia = 1 
  For x = 2 To 126 Step 4 
    For y = 2 To 48 Step 6 
        Set PlageTravail = Range("C" & x & ":C" & y) 
        'Alimente les éléments du tableau 
                Onglet.Cells(x, y) = retournLibelle(ia, TbloLibel) 
                ia = ia + 1 
                If ia > UBound(TbloLibel) Then 
                    Exit Sub 
                End If 
           Next y 
    Next x 


End Sub 

'Fonction qui retourne le libelle du tableau 
Function retournLibelle(indice As Integer, ByRef varTab() As Variant) As Variant 
        retournLibelle = varTab(indice, 2) 
End Function 

Pour reprendre le fonctionement du fichier :
Il faut implémenter le code dans la premiere celule de dotation (la seconde est issue d'une recherchev dans l'onglet database) ensuite une quantité et la dernière colone est issue de la valeur de Dot/pv /2 .

Ensuite il faut cliquer sur le bouton generer et la suite est expliquée dans mes precedents posts.

@michel_m : je n'ai pas encore fait la fonction de tri juste trouvé quelques exemples sur www.
En fait l'idée est de trier le trableau en fonction des différentes Liste (onglet dotation issus d'une rechercheV) .Peut être faire un filtre ou autre .... je n'ai pas encore reflechit à cette fonction.

Et l'onglet etiquette est l'onglet final j'ai mis un exemple de ce que souhaite avoir.

Vous remerciant,

Bonjour,

J'ai l'impression que tu t'es bien casser la t^te....

dans l'onglet dotation j'ai remplacer les cases à cocher (controles formulaire) par des checkboxs (controle activex) plus adaptés au VBA

Option Explicit  
Dim TbloLibel() As Variant  

Sub Bouton5_Clic()  
 Dim Petite As Boolean, Grande As Boolean  
       
    'initialisations  
    Application.ScreenUpdating = False 'fige le défilement de l'écran  
    With Sheets("Dotation")  
          TbloLibel = .Range("A2:E" & Range("A" & Rows.Count).End(xlUp).Row).Value  
          Petite = .CheckBox1  
          Grande = .CheckBox2  
    End With  
      
    'rédaction des étiquettes  
    If Petite = True Then etiqueter Sheets("etiquette pt")  
     If Grande = True Then etiqueter Sheets("etiquette grd")  

     MsgBox "Etiquetage terminé"  
End Sub  

Sub etiqueter(onglet)  
Dim indice As Integer, Ligne As Byte, Col As Byte  
With onglet  
     .Cells.ClearContents  
     '    Remplir la case 'libellé'  
          indice = 1  
          For Ligne = 2 To 126 Step 4  
               For Col = 2 To 48 Step 6  
                    .Cells(Ligne, Col) = TbloLibel(indice, 2)  
                    indice = indice + 1  
                    If indice > UBound(TbloLibel) Then Exit Sub  
               Next Col  
          Next Ligne  
     End With  
End Sub  

Quant à ton Tri, je ne connais ni ton critère de tri , ni ce que tu veux faire donc...

dis toi bien que nous n'avons que tes écrits pour essayer de te proposer qqchose et que l'on ne connait tout ce que tu veux faire
ainsi dans les étiquettes, tu parles de code EAN et de code ? quès aco ? d'où viennent ces infos?
en VBA, il est nécessaire d'avoir une description complète car tout information supplémentaire peut obliger à revoir tous les codes... :o)

Michel

Bonsoir Michel ,

Merci pour ce retour de code.
En effet je me suis bien cassé la tête au vu de ton code (mais je fait avec mes connaissances et mon code fonctionne au final, bon je te l'accorde peut être sur 3 pattes)
Maintenant je vais continuer à travailler en suivant ta source.
En ce qui concerne les informations rien n'est inventé tout est issus de l'onglet 'dotation' et recupère ces sources dans l'onglet database les données sont juste 'organisées' en vue de leur impression :
Le code ean (police ean code 3 9) est issu du code de référence (donnée colonneA dans le premier onglet) .

Pour le tri en fait il faut que je réorganise le 'array' en fonction des 3 listes (L1,L2,SL) car les couleurs des etiquettes different selon cette reference.

Pour info j'ai travaillé sur le code hier soir et voila ce que ca donne.
En tout cas merci pour vos propositions et vos conseils

Sub Bouton5_Clic()
    Dim DernLigne As Long
    DernLigne = Range("A" & Rows.Count).End(xlUp).Row
    RangeArray DernLigne
   
End Sub


Sub RangeArray(DrLgn As Long)
    'Declaration du tableau taille dynamique et redimension du tableau
    Dim TbloLibel() As Variant
With Sheets("Dotation").Range("A2:E" & DrLgn)
    ReDim TbloLibel(.Rows.Count, .Columns.Count)
    'Affecte les valeurs au tableau
    TbloLibel = .Value
    'MsgBox UBound(TbloLibel)

End With

Dim x As Integer, y As Integer, i As Integer, ia As Integer
Dim Onglet As Worksheet
Dim PlageTravail As Range
    
    Set Onglet = Worksheets("etiquette pt")
    Onglet.Select


'efface les données
For x = 1 To 126
For y = 1 To 48
Onglet.Cells(x, y) = ""
Next y
Next x


'Remplir la case 'libellé'
ia = 0
For x = 2 To 126 Step 4
    For y = 2 To 48 Step 6
        'Alimente les éléments du tableau
        ia = ia + 1
        If ia > UBound(TbloLibel) Then
            Onglet.Cells(x, y) = ""
        Else
            Onglet.Cells(x, y) = retournLibelle(ia, TbloLibel)
        End If
    Next y
Next x

'rapel : lign x , colonne y


'Remplir la case 'code'
ia = 0
For x = 3 To 127 Step 4
    For y = 4 To 48 Step 6
        'Alimente les éléments du tableau
        ia = ia + 1
        If ia > UBound(TbloLibel) Then
            Onglet.Cells(x, y) = ""
        Else
            Onglet.Cells(x, y) = retournCode(ia, TbloLibel)
        End If
            Onglet.Cells(x, y - 1) = "*" & Onglet.Cells(x, y).Value & "*"
    Next y
Next x


'Remplir la case 'liste'
ia = 0
For x = 3 To 127 Step 4
    For y = 2 To 48 Step 6
        'Alimente les éléments du tableau
        ia = ia + 1
        If ia > UBound(TbloLibel) Then
            Onglet.Cells(x, y) = ""
        Else
            Onglet.Cells(x, y).Font.ColorIndex = 10
            Onglet.Cells(x, y) = retournListe(ia, TbloLibel)
        End If
    Next y
Next x


End Sub

'Fonction qui retourne le libelle du tableau
Function retournLibelle(indice As Integer, ByRef varTab() As Variant) As Variant
        retournLibelle = varTab(indice, 2)
End Function

Function retournCode(indice As Integer, ByRef varTab() As Variant) As Variant
        retournCode = varTab(indice, 1)
End Function

Function retournListe(indice As Integer, ByRef varTab() As Variant) As Variant
        retournListe = varTab(indice, 5)
End Function

Bonsoir Didoch54000,
Tu fait appel à plusieurs fonctions pour remplir ta 2ème feuille. Comme il ne s'agit que d'un seul et unique tableau, tu peux tout regrouper dans le code, sans même faire appel à un fonction (ou procédure) en utilisant deux boucles imbriquées :

Dim i as Integer, j as Integer 
' 
For i =0 to Ubound(tablo,1) 
....For j =0 to Ubound(tablo,2) 
........If (Condition)
............Code pour remplir la feuille provenant des valeurs du tableau à 2 dim
........End if
....Next j 
Next i

Bonjour,

Décidément, tu persiste à donner les renseignements au goutte à goutte

Donc, je ne vais plus perdre mon temps d'autant plus que tu reprends ton code pratiquement en entier avec des fonctions et cascades de macros inutiles

Bonsoir michel,heliotte,

Michel desole que tu le prenne comme ca le code publié precedement etait sans avoir vu le tien bien plus exlicite et performant. Pour les renseignements je pensait avoir été explicite mais non a priori.
Cela dit merci a vs 2 pour vos conseils et aide apporté.
Bonne continuation