Vous utilisez un navigateur obsolète. Il se peut que ce site ou d'autres sites Web ne s'affichent pas correctement. Vous devez le mettre à jour ou utiliser un navigateur alternatif.
XL 2016Transférer de données d'un tableau a un autres avec des conditions
Bonjour je viens a vous les experts, cas j'essaye de faire un programme vba qui irai cherche le code formule présent dans la feuille "data p" dans la feuille "data 1".
Quand le code est trouvé renvoyé les valeurs des cellule non vide de cette colonne dans le tableau "data p" a des emplacement bien défini. En sachant qui il aura d'autres formule, groupe, ingrédient.
je vous joins le fichier en question.
Merci de votre aide.
regarde la 2ème feuille "data p" ; va sur la 1ère feuille "data 1", et fais Ctrl e ➯ travail effectué ! bonus pour chaque feuille : fais Ctrl F2 ➯ aperçu avant impression : c'est prêt à être imprimé ! sur la feuille "data 1", si tu ajoutes des formules, des ingrédients, et des groupes, ils seront automatiquement pris en compte, sans devoir modifier le code VBA.
code VBA de Module1(62 lignes) :
VB:
Option Explicit
Dim sh As Worksheet
Sub Essai()
If ActiveSheet.Name <> "data 1" Then Exit Sub
Dim dcl%: dcl = Cells(5, Columns.Count).End(1).Column: If dcl = 4 Then Exit Sub
Dim dlg&: dlg = Cells(Rows.Count, 1).End(3).Row: If dlg < 7 Then Exit Sub
Dim cel As Range, grp$, lg1&, lg2&, lg3&, lg4&, col%, k As Byte
Set sh = Worksheets("data p"): lg1 = 6: lg4 = 6: dcl = dcl - 1
lg2 = sh.Cells(Rows.Count, 1).End(3).Row: Application.ScreenUpdating = 0
If lg2 > 5 Then ClrTbl lg2 'effacer les anciens résultats
Do
lg2 = lg1
Do
lg2 = lg2 + 1
Loop Until Cells(lg2, 1).MergeArea.Columns.Count > 1 Or lg2 > dlg
grp = Cells(lg1, 1): lg1 = lg1 + 1: lg2 = lg2 - 1
For col = 5 To dcl Step 2
For lg3 = lg1 To lg2
k = Val(Cells(lg3, col))
If k > 0 Then
Set cel = Cells(lg3, 1)
With sh.Cells(lg4, 1)
.Value = grp 'Groupe
.Offset(, 1) = Cells(4, col) 'Code formule
.Offset(, 2) = cel.Offset(, 3) 'Ingrédient
.Offset(, 3) = cel.Offset(, 2) 'Emplacement
.Offset(, 4) = cel.Offset(, 1) 'Masse
.Offset(, 5) = cel 'Code article
.Offset(, 6) = k 'Ordre incorporation
.Offset(, 7) = Cells(lg3, col + 1) '%
End With
BordA lg4, 9, 1: lg4 = lg4 + 1
End If
Next lg3
Next col
BordA lg4, 8, 3: lg1 = lg2 + 1
Loop Until lg2 > dlg
BordB lg4 - 1: sh.Select
End Sub
Private Sub ClrTbl(lg2&)
With sh.Range("A6:H" & lg2)
.ClearContents: .Borders.LineStyle = -4142
With .Resize(1).Borders(8): .LineStyle = 1: .Weight = 3: End With
End With
End Sub
Private Sub BordA(lg4&, t As Byte, w As Byte)
With sh.Cells(lg4, 1).Resize(, 8).Borders(t): .LineStyle = 1: .Weight = w: End With
End Sub
Private Sub BordB(lg4&)
Dim i As Byte
With sh.Range("A6:H" & lg4)
For i = 7 To 11
If i = 7 Or i > 9 Then With .Borders(i): .LineStyle = 1: .Weight = 3: End With
Next i
End With
End Sub
si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis.
salut soan merci pour ton aide, moi je voudrais qu'a chaque changement de formule sur la feuille data P les valeurs lié a la formule choisi s'affiche automatique sans faire ctrl +e car l'onglet data1 sera masqué.
sur la 2ème feuille "data p", note qu'il n'y a plus de formule en N1 ; va en D1, et saisis "FORMULE 1" ; vérifie les résultats ; dans la barre de formule, change le 1 en 2 ➯ "FORMULE 2" ; vérifie les nouveaux résultats ; effaceD1 avec la touche Suppression(ben oui, hein ? c'est normal ! ) ; saisis "FORMULE 3" ; vérifie les nouveaux résultats ; saisis "FORMULE 6" (logique, hein ? ) ; voici une bonne nouvelle : si tu masques la feuille "data 1", ça marchera tout aussi bien !
code VBA du module de "data p"(65 lignes) :
VB:
Option Explicit
Private Sub Job(lg2&)
[N1] = ""
If lg2 > 5 Then
With Range("A6:H" & lg2)
.ClearContents: .Borders.LineStyle = -4142
With .Resize(1).Borders(8): .LineStyle = 1: .Weight = 3: End With
End With
End If
End Sub
Private Sub Bordures(lg2&)
Dim i As Byte
With Range("A6:H" & lg2)
For i = 7 To 11
If i <> 8 Then With .Borders(i): .LineStyle = 1: .Weight = 3: End With
Next i
With .Borders(12): .LineStyle = 1: .Weight = 1: End With
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vx$, lg2&, c&
With Target
If .Cells(1).Address <> "$D$1" Then Exit Sub
lg2 = Cells(Rows.Count, 1).End(3).Row
c = .CountLarge: Application.ScreenUpdating = 0
If c = 10 Then Job lg2: Exit Sub
vx = .Value
End With
If c > 1 Then Exit Sub
Dim sh As Worksheet, dcl%: Set sh = Worksheets("data 1")
dcl = sh.Cells(5, Columns.Count).End(1).Column: If dcl = 4 Then Exit Sub
Dim dlg&: dlg = sh.Cells(Rows.Count, 1).End(3).Row: If dlg < 7 Then Exit Sub
Dim CF$, col%, k As Byte: dcl = dcl - 1
For col = 5 To dcl Step 2
If sh.Cells(1, col) = vx Then CF = sh.Cells(4, col): k = 1: Exit For
Next col
If k = 0 Then Job lg2: Exit Sub
Dim cel As Range, grp$, lg1&: [N1] = CF: lg2 = 6
For lg1 = 6 To dlg
Set cel = sh.Cells(lg1, 1)
If cel.MergeArea.Columns.Count > 1 Then
grp = cel
Else
k = Val(sh.Cells(lg1, col))
If k > 0 Then
With Cells(lg2, 1)
.Value = grp 'Groupe
.Offset(, 1) = CF 'Code formule
.Offset(, 2) = cel.Offset(, 3) 'Ingrédient
.Offset(, 3) = cel.Offset(, 2) 'Emplacement
.Offset(, 4) = cel.Offset(, 1) 'Masse
.Offset(, 5) = cel 'Code article
.Offset(, 6) = k 'Ordre incorporation
.Offset(, 7) = sh.Cells(lg1, col + 1) '%
End With
lg2 = lg2 + 1
End If
End If
Next lg1
Bordures lg2 - 1
End Sub
si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis.
Dim sh As Worksheet : sh : variable de type Feuille de calcul (j'ai choisi le nom sh pour sheet)
Private Sub ClrTbl(lg2&) .. End Sub : le but de cette sub est d'effacertout le tableau de la feuille "data p", pour éviter toute interférence entre d'anciens résultats et les nouveaux ; lors de l'appel de cette sub, sh référence "data p" et la sub reçoit lg2, qui est le n° de la dernière ligne utilisée (selon la colonne A) ; attention : comme la 1ère ligne de données est la ligne 6, cette sub n'est appelée que si lg2 est supérieur à 5 ➯ valeur minimum pour lg2 : 6.
With sh.Range("A6:H" & lg2) .. End With : si par exemple lg2 = 14, alors c'est avec "A6:H14"
.ClearContents : on efface le contenu des cellules
.Borders.LineStyle = -4142 : idem que .Borders.LineStyle = xlNone : on efface toutes les bordures
With .Resize(1) : le With précédent est réduit en taille à 1 seule ligne : "A6:H6"
With .Resize(1).Borders(8) : comme 8 est idem que xlEdgeTop, c'est pour la bordure haut de "A6:H6"
.LineStyle = 1: .Weight = 3 : comme plus haut on avait effacé toutes les bordures, on doit retracer la bordure haut de la ligne 6
Private Sub BordA(lg4&, t As Byte, w As Byte) .. End Sub : cette sub est pour tracer sur la ligne lg4 une bordure hautoubas(selon que le type de bordure « reçu »t sera 9 ou 8 ; 9 = xlEdgeBottom ; 8 = xlEdgeTop) ; l'épaisseur du trait « reçue »w sera 1 ou 3 ; 1 = xlHairline ; 3 = xlMedium (w : initiale de weight).
With sh.Cells(lg4, 1) : avec la cellule de la ligne lg4, colonne 1(donc colonne A)
.Resize(, 8) : étendu à 8 colonnes ➯ ligne lg4, des colonnes 1 à 8(donc colonnes A à H)
.Borders(t) : pour la bordure de type t : 9 ou 8 = xlEdgeBottom ou xlEdgeTop
.LineStyle = 1: .Weight = w : tracer le trait fin ou fort(en bas ou en haut selon t)
Private Sub BordB(lg4&) .. End Sub : cette sub est pour tracer le contour à l'aide de lg4, mais comme le trait haut est déjà mis, on tracera seulement les 3 autres côtés.
Dim i As Byte : déclare une variable i, de type octet
With sh.Range("A6:H" & lg4) .. End With : si par exemple lg4 = 14, avec "A6:H14"
For i = 7 To 11 .. Next i : boucle i, de 7 à 11
If i = 7 Or i > 9 Then : ça élimine le 9 ; c'est donc pour : 7 ; 8 ; 10 ; 11
With .Borders(i) .. End With : avec la bordure du type i ci-dessus ; c'est donc pour ces 4 types de bordures : 7 ; 8 ; 10 ; 11 ; or 7 = xlEdgeLeft ; 8 = xlEdgeTop ; 10 = xlEdgeRight ; 11 = xlInsideVertical
.LineStyle = 1: .Weight = 3 : on trace un trait d'épaisseur 3 = xlMedium
voici la dernière partie du commentaire de mon code VBA.
Sub Essai() .. End Sub : c'est cette sub qui est la sub principale ; et c'est elle qui va appelerles autres qui ont été décrites dans mes 2 posts précédents #11 et #12.
If ActiveSheet.Name <> "data 1" Then Exit Sub : on quitte la sub si la feuille active n'est pas "data 1" ; donc pour la suite du code VBA, on est au départ sur "data 1".
Dim dcl% : idem que Dim dcl As Integer ; dcl = nom abrégé de : "dernière colonne".
dcl = Cells(5, Columns.Count).End(1).Column ; .End(1) idem que .End(xlToLeft) ; trouver quelle est la dernière colonne, selon la ligne 5 ; donc ici, sur la ligne 5, le n° dernière colonne est 10 = J ; c'est grâce à cette détection qu'il t'est possible d'ajouter d'autres Formules à droite : "Formule 4" ; "Formule 5" ; "Formule 6" ; etc...
If dcl = 4 Then Exit Sub : on quitte la sub si la dernière colonne est 4, car si la dernière colonne est D, ça signifie qu'y'a aucune Formule!(donc y'a aucun job à faire !)
Dim dlg& : idem que Dim dlg As Long ; dlg = nom abrégé de : "dernière ligne".
dlg = Cells(Rows.Count, 1).End(3).Row ; .End(3) idem que : .End(xlUp) ; trouver quelle est la dernière ligne, selon la colonne A ; c'est grâce à cette détection qu'il t'est possible d'ajouter d'autres groupes en dessous : "GROUPE 4" ; "GROUPE 5" ; "GROUPE 6" ; etc...
If dlg < 7 Then Exit Sub : on quitte la sub si le n° dernière ligne est inférieur à 7, car c'est seulement à partir de la ligne 7 qu'il y a un ingrédient en colonne D ; noter que si dlg <=6 : y'a pas d'ingrédient ➯ y'a aucun job à faire !
Dim cel As Range, grp$, lg1&, lg2&, lg3&, lg4&, col%, k As Byte : déclaration de plusieurs variables ; Dim grp$ : idem que Dim grp As String ; j'en parlerai au fur et à mesure.
Set sh = Worksheets("data p") : sh référence la feuille "data p".
lg1 = 6 : lg1 = abrév. pour "ligne 1" ; lg1 = 6, car 6 est la ligne du 1er groupe "GROUPE 1".
lg4 = 6 : lg4 = abrév. pour "ligne 4" ; lg4 = 6, car 6 est la 1ère ligne où on va écrire les résultats (sur la feuille "data p").
dcl = dcl - 1 : on enlève 1 à dcl, donc dans cet exemple : dcl = 10 - 1 = 9 = I ➯ c'est la dernière colonne "Ordre d'incorporation" (celle du dernier groupe).
lg2 = sh.Cells(Rows.Count, 1).End(3).Row : lg2 = abrév. pour "ligne 2" ; .End(3) : idem que .End(xlUp) ; sur la feuille "data p", trouver quelle est la dernière ligne, selon la colonne A.
Application.ScreenUpdating = 0 : désactivation de la mise à jour de l'écran ➯ exécution plus rapide.
If lg2 > 5 Then ClrTbl lg2 : c'est seulement si lg2 est supérieur à 5 qu'on appelle la sub ClrTbl() pour effacer d'anciens résultats.
Do .. Loop Until lg2 > dlg : 1ère boucle Do ; s'arrêtera si lg2 devient supérieur à dlg.
lg2 = lg1 : lg2 avait servi pour l'effacement des anciens résultats ; maintenant, je m'en sers pour autre chose ; et ici, lg2 est égal à lg1, donc 6 : ligne du 1er groupe "GROUPE 1" ; on va de suite rechercher (ci-dessous) quelle est la dernière ligne du groupe « en cours ».
VB:
Do
lg2 = lg2 + 1
Loop Until Cells(lg2, 1).MergeArea.Columns.Count > 1 Or lg2 > dlg
on ajoute 1 à lg2 jusqu'à ce qu'on rencontre une cellule fusionnée (ici A1212 pour "GROUPE 2" ➯ lg2 = 12)OU jusqu'à ce que lg2 devienne supérieur à dlg.
grp = Cells(lg1, 1) : grp = le nom du groupe, ici : "GROUPE 1".
lg1 = lg1 + 1 : lg1 = la 1ère ligne de données du groupe, juste sous le nom du groupe : 7.
lg2 = lg2 - 1 : lg2 = la ligne qui est juste au-dessus du nom du groupe suivant : 11.
oh ! comme c'est super pratique ! on vient tout juste de trouver que pour le 1er groupe "GROUPE 1", ça va des lignes 7 à 11 ! c'est-y pas génial ? c'est cette même méthode qui permettra de trouver que pour "GROUPE 2", ça va des lignes 13 à 19 ; puis pour "GROUPE 3", ça va des lignes 21 à 33 ; avec cette toute petite différence près : pour le dernier groupe, la dernière ligne n'est pas trouvée grâce à la cellule fusionnée du groupe suivant, mais simplement car lg2 est supérieur à dlg ; eh oui, car le dernier groupe étant le dernier (par définition), il n'y a pas d'autres groupes en dessous ➯ pour ce dernier groupe, le seul moyen d'en détecter la dernière ligne est de comparer lg2 et dlg, sans quoi on va créer une boucle sans fin ! ➯ blocage ! remarque : ceci était la plus grosse difficulté de cet exercice, et on vient de la résoudre !
For col = 5 To dcl Step 2 .. Next col : boucle des colonnes 5 à dcl, par pas de 2 ; ce sera donc, pour chaque Formule, la colonne "Ordre d'incorporation" : 5 = E ; puis 7 = G ; puis 9 = I.
For lg3 = lg1 To lg2 : boucle des lignes lg1 à lg2; eh oui, ce sont ces numéros de ligne qu'on a eu tant de mal à déterminer ! ici, pour "GROUPE 1", c'est donc 7 à 11 ; ça colle bien, hein ?
k = Val(Cells(lg3, col)) : k = ce qu'il y a en colonne "Ordre d'incorporation" pour une Formule donnée ; c'est donc soit le n° qui est inscrit dans cette colonne, soit0(si la cellule est vide) ; le Val() est là pour éviter un plantage si l'utilisateur saisit par mégarde du texte au lieu d'un n° d'ordre d'incorporation ; dans ce cas, Val() du texte retourne 0(c'est donc la même valeur que si la cellule était vide).
If k > 0 Then .. End If : on va s'occuper du n°seulement s'il est supérieur à 0(donc on ne fera rien si la cellule était vide, ou si elle contenait du texte).
Set cel = Cells(lg3, 1) : cel référence la cellule de la ligne lg3, colonne A ; c'est donc le Code article de la ligne.
With sh.Cells(lg4, 1) .. End With : avec la cellule lg4, colonne A, de la feuille "data p".
les instructions incluses dans le With ci-dessus vont écrire sur "data p" une ligne de résultat, à raison de 8 infos par ligne ; ces 8 infos étant celles qui sont indiquées par le commentaire vert de la ligne ; noter que .Offset(, 1) signifie : 1 colonne à droite de la cellule indiquée par le With ; et cel.Offset(, 3) signifie : 3 colonnes à droite de la cellule cel, donc 3 colonnes à droite du Code article de la ligne.
BordA lg4, 9, 1 : tracer sur la ligne lg4 une bordure bas (xlEdgeBottom) et très fine (xlHairLine).
lg4 = lg4 + 1 : on augmente lg4 de 1, pour la ligne de résultat qui suivra.
BordA lg4, 8, 3 : tracer sur la ligne lg4 une bordure haut (xlEdgeTop) et assez forte (xlMedium).
BordB lg4 - 1 : pour tracer le contour (en fait, 3 côtés seulement, car le trait haut est déjà tracé).
sh.Select : on va sur la feuille "data p" pour montrer les résultats.
Salut Soan, peut tu me modifier le ficher du 8 juin 2021 que tu m'avez fait de sorte que si je rajoute des colonnes pour de nouvelle formule et/ou modifier les lignes de sorte que je rajoute de nouveau groupe ou d'autres ingrédient dans les groupe existants.
Ce site utilise des cookies pour personnaliser le contenu, adapter votre expérience et vous garder connecté si vous vous enregistrez.
En continuant à utiliser ce site, vous consentez à notre utilisation de cookies.
.
sur la feuille "
)
)
