Amélioré une boucle
Bonjour
Je cherche de l'aide pour améliorer une boucle si c'est possible.
Je souhaite récupérer la totalité et référence des tailles a la suite de la désignation de l'article en colonne B.
J'ai bien bien trouvé une macro qui effectue un peu près ce que je veux mais je n'arrive pas a l'integrer dans la boucle de la macro "Renouvellement" sans ajouter la colonne AQ dans ma feuille "Demande" (si possible).
Pour plus de compréhension j'ai expliqué en mettant un exemple sur la feuille "A commander".
Si vous souhaitez plus d'infos, faite signe.
Merci
Cdlt
Bonjour le forum
J'aimerai bien pouvoir terminer mon projet, personne pour m'aider ??? SVP
Cdlt
Bonjour Pompaero, bonjour le forum,
Une solution capillotractée avec pas moins de 6 boucles (je ne tente aucun record, je t'assure) mais qui semble fonctionner...
Sub Renouvellement()
Dim I As Integer
Dim S0 As String 'déclare la variable S0 (Séparation 0)
Dim S1 As String 'déclare la variable S1 (Séparation 1)
Dim NS As Byte 'déclare la variable NS (Nombre de Séparation)
Dim TS1() As String 'déclare la variable TS1 (Tableau de Séparations 1)
Dim TS2() As Variant 'déclare la variable TS2 (Tableau de Séparations 2)
Dim U As String 'déclare la variable U (Union)
Dim X As Integer 'déclare la variable X(incrément)
Dim Y As Integer 'déclare la variable Y (incrément)
Application.ScreenUpdating = False
Application.Run ("Design")
With Sheets("A commander")
.Range("A5:F" & .Range("A" & Rows.Count).End(xlUp).Row + 1).ClearContents
.Rows("8:80").Delete Shift:=xlUp
Lgn = 5 'Ligne d'écriture
Ln = 7 'Ligne de lecture
While Range("A" & Ln).Value <> ""
If Range("D" & Ln).Value > 0 Then
.Range("A" & Lgn).Value = Range("A" & Ln).Value 'Colonne Fournisseur Référence
.Range("B" & Lgn).Value = Range("AQ" & Ln).Value 'Colonne Désignation
.Range("C" & Lgn).Value = Range("C" & Ln).Value 'Colonne Référence Fournisseur
.Range("D" & Lgn).Value = Range("D" & Ln).Value 'Colonne Q à commander Conditionnement
.Range("E" & Lgn).Value = Range("E" & Ln).Value 'Colonne Unité
.Range("F" & Lgn).Value = Range("F" & Ln).Value 'Colonne Somme Q à commander
Sheets("A commander").Range("A3").Value = Sheets("Demande").Range("A4").Value 'Cellule année Colonne Prix catalogue
Lgn = Lgn + 1
End If
Ln = Ln + 1
Wend
' Dernière Ligne
I = .Range("A" & Rows.Count).End(xlUp).Row
'Formule de Somme en F3
.Range("F3").FormulaR1C1 = "=SUM(R[2]C:R[" & I - 3 & "]C)"
' Copie du Format pour le tableau
.Rows("5:5").Copy
.Rows("6:" & I).PasteSpecial Paste:=xlPasteFormats
' Finir le Tableau avec la dernière ligne en gras
With .Range("A" & I & ":F" & I).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
For I = 5 To .Cells(Application.Rows.Count, 2).End(xlUp).Row 'boucle 1 : des lignes 5 à ... dernière ligne éditée de la colonne B
Erase TS1: Erase TS2: U = "" 'initialise tableaux et variable U
With .Cells(I, 2) 'prend en compte la cellule en colonne 2 (=B) de la ligne
S0 = Split(.Value, " ")(0) 'définit la variable S0 (texte avant les 10 espaces)
S1 = Split(.Value, " ")(1) 'définit la variable S1 (texte après les 10 espaces)
If S1 <> "" Then 'condition 1 : si S1 n'est pas vide
NS = UBound(Split(S1, " - ")) 'définit la variable NS (Nombre de données Séparées par " - ")
ReDim TS1(NS) 'redimensionne le tableau TS1
For Y = 0 To NS 'boucle 2 : de 0 à NS
TS1(Y) = Split(S1, " - ")(Y) 'alimente le tableau TS1 avec la donnée "xxx/yyy")
Next Y 'prochaine valeur de la boucle 2
For Y = 0 To NS 'boucle 3 : de 0 à NS
ReDim Preserve TS2(1, NS) 'redimentionne le tableau TS2
TS2(0, Y) = Split(TS1(Y), "/")(0) 'dans la colonne 0 de TS2 la valeur avant le "/"
TS2(1, Y) = CInt(Split(TS1(Y), "/")(1)) 'dans la colonne 1 de TS2 la valeur après le "/" (convertie en entier)
Next Y 'prochaine valeur de la boucle 3
For X = 0 To NS 'boucle 4 : de 0 à NS
For Y = 0 To NS 'boucle 5 : de 0 à NS
'condition 2 : si les valeurs en colonne 0 les deux tableaux sont identique et que X est différent de Y
If TS2(0, X) = TS2(0, Y) And X <> Y Then
TS2(1, X) = TS2(1, X) + TS2(1, Y) 'additionne la valeur1 en colonne 1 avec la valeur2 en colonne 1
TS2(0, Y) = 0 'redéfinit la valeur colonne 0 de la seconde valeur (tag)
End If 'fin de la condition 2
Next Y 'prochaine valeur de la boucle 5
Next X 'prochaine valeur de la boucle 4
For X = 0 To NS 'boucle 6 : de 0 à NS
If TS2(0, X) <> 0 Then 'condition 3 : si la valeur en colonne 0 de TS2 est différente de "0"
'définit la variable U (union)
U = IIf(U = "", TS2(0, X) & "/" & TS2(1, X), U & " - " & TS2(0, X) & "/" & TS2(1, X))
End If 'fin de la condition 3
Next X 'prochaine valeur de la boucle 6
.Value = S0 & " " & U 'rédefinit la valeur de la cellule
End If 'fin de la condition 1
End With 'fin de la prise en compte de la cellule en colonne 2 (=B) de la ligne
Next I 'prochaine ligne de la boucle 1
.Select 'sélectionn el'onglet
.Range("A1").Select 'sélectionne la cellule A1
End With 'fin de la prise en compte de l'onglet "A commander"
End SubBonjour ThauThème
Grand merci de t'avoir arrêté sur mon post et de prendre de ton temps pour m'aider.
Après lecture de ta macro je vois que cela additionne comme je le souhaite, mais m'aperçois (sauf erreur de ma part) que si la 1ère colonne G et H ne sont pas remplis et si une personne ne note rien cela arrête la macro (donc ne récupère pas les infos suivantes.
est ce normal ?
Si j'ai bien compris j'aimerai le même résultat mais avec possibilité qu'une personne ne remplisse pas ses tailles et récupérer les tailles suivantes.
Il est possible que la première personne ne renseigne pas ses taille également.
Toutes mes excuses de n'avoir pas plus expliqué dans le détail dans mon 1er message.
Cdlt
Bonjour,
Une nouvelle proposition à étudier.
Normalisation des données et TCD.
Cdlt.
Bonjour le fil, bonjour le forum,
pompaero a écrit :Après lecture de ta macro je vois que cela additionne comme je le souhaite, mais m'aperçois (sauf erreur de ma part) que si la 1ère colonne G et H ne sont pas remplis et si une personne ne note rien cela arrête la macro (donc ne récupère pas les infos suivantes.
C'était déjà comme ça avant ma proposition dans ton fichier initial ! Et comme tu n'en as pas parlé dans tes explication, je n'ai pas cherché de solution pour ça...
Bonjour ThauThème et Jean-Eric
D'abord merci de votre aide si précieuse.
ThauThème :
je suis sincèrement désole pour le manque d'explication c'est vrai que j'ai oublié de préciser qu'il peut y avoir des personnes qui ne commande pas d'articles.
Jean Eric :
encore merci de ta proposition qui est très bien pensé (et que je vais garder sous le coude) mais comme tu peux voir dans le fichier en PJ avec quelques explications j'ai déjà créer mes bon de commande qui se remplissent automatiquement à l'aide de la feuille "A commander" c'est pour ça que j'aimerai poursuivre dans le principe de la macro de ThauThème.
en claire il reste juste le problème des cellules vide qui ne sont pas prix en compte, donc ça bloque et ne récupère pas toutes les infos.
Il me reste que cela à résoudre pour finaliser le projet.
Cdlt
Bonjour,
Malheureusement ... le même scénario semble encore se répéter ...
Bonjour le fil, bonjour le forum,
Arf James ! Je navet (si, si, dans ce cas on peut) pas vu ce fil. On se ferait presque engueuler quand on le contrarie...
C'est vrai qu'il ne peut pas tout savoir mais répéter deux fois la même erreur dans deux fils différents, c'est couillon quand même...
bonjour messieurs
je vois que je l'air d'être ciblé !!!!!
De quelle erreur s'agit il svp ? que je puisse éviter de la poursuivre puis je rassure j'engueule personne, chose que je n'oserai pas car c'est vous les pros et non moi.
je cherche simplement de l'aide.
Cdlt.
Bonsoir le fil, bonsoir le forum,
Non Pompaero, tu n'es pas "ciblé" ! Il faut juste que tu saches que les fils en doublon sont rarement appréciés dans les forums. La plupart du temps le demandeur s'y perd lui-même et rate une solution proposée dans un autre fil.
Il faudrait aussi que tu prennes l'habitude de préparer un "cahier des charges" pour ton problème.
Je déteste quand, après avoir proposé une solution, on vient me dire il faut rajouter ci ou ça... Il y a plein de méthodes différentes pour atteindre une solution et souvent elles dépendent du "cahier des charges". Si celui-ci évolue, il faut parfois tout repenser et tout refaire... Dans ces cas-là, souvent, je passe la main...
Je te rassure, je suis loin d'être pro, j'apprends tous les jours... Mais je ne roucoule pas non plus...
Bonne Chance !