Simplification VBA
Bonjour,
J'aimerais simplifier ce code mais je ne sais pas comment faire :
Sub importation()
Dim x As Variant
Dim y As Variant
Dim i As Variant
Dim WB As Worksheet
Dim WR As Worksheet
Set WB = ThisWorkbook.Worksheets("Base")
Set WR = ThisWorkbook.Worksheets("Requete Nomenclatures CLEM")
With WB
For x = 5 To .Range("A" & .Rows.Count).End(xlUp).Row
If .Cells(x, 1).Value = WR.Cells(2, 2).Value Then
For y = 2 To 7
If WB.Cells(x, y) <> 0 Then
For i = Range("tableau").Row To Range("tableau").Row + 119
If WR.Cells(i, 12) = "" Then
WR.Cells(i, 12) = WB.Cells(4, y)
WR.Cells(i, 13) = WB.Cells(x, y)
Exit For
End If
Next
End If
Next
End If
If .Cells(x, 1).Value = WR.Cells(3, 2).Value Then
For y = 2 To 7
If WB.Cells(x, y) <> 0 Then
For i = Range("tableau").Row To Range("tableau").Row + 119
If WR.Cells(i, 12) = "" Then
WR.Cells(i, 12) = WB.Cells(4, y)
WR.Cells(i, 13) = WB.Cells(x, y)
Exit For
End If
Next
End If
Next
End If
Next
End With
End SubCar en fait je dois aller jusqu'à la cellule "WR.Cells(14 000, 2)"
Avez-vous une idée ?
Merci
Cleiiim
Bonjour,
je crois que cela va être compliqué si tu ne nous fournis pas le fichier (anonymisé) qui va avec cette macro.
Bonjour,
Tu peux faire une fonction comme ça :
With WB
For x = 5 To .Range("A" & .Rows.Count).End(xlUp).Row
TabClem 2
TabClem 3
Next
End WithFunction TabClem(a As Integer)
If .Cells(x, 1).Value = WR.Cells(a, 2).Value Then
For y = 2 To 7
If WB.Cells(x, y) <> 0 Then
For i = Range("tableau").Row To Range("tableau").Row + 119
If WR.Cells(i, 12) = "" Then
WR.Cells(i, 12) = WB.Cells(4, y)
WR.Cells(i, 13) = WB.Cells(x, y)
Exit For
End If
Next
End If
Next
End If
End FunctionSteelson, désolé le voici
J'ai fait un autre code, car en fait je voudrai que mes valeurs commencent à se mettre à côté de la référence concernée, le problème c'est que toutes mes valeurs s'écrasent et seule la dernière reste.
Voici le fichier avec ce code :
Merci Oxydum, je vais regarder ton code de plus près, je n'ai jamais utilisé de fonction en vba.
Merci pour vos réponses
Cleiiim
Oxydum,
Je ne comprends pas ta première partie (les TabClem 2 et TabClem 3)
With WB
For x = 5 To .Range("A" & .Rows.Count).End(xlUp).Row
TabClem 2
TabClem 3
Next
End WithC'est basique, soit :
Function toto(Argument As Range)
toto=Argument.Cells.Value
End FunctionSi tu appelles depuis une cellule A2 par exemple =toto(A1)
tu reçois en retour la valeur de la cellule A1.
Function tata(Argument As Variant)
tata=Argument
End FunctionSi tu appelles depuis un module VBA la fonction tata, tu reçois en retour la valeur que tu as passée.
par exemple :
Sub Test()
MsgBox (tata("Hello"))
End Subcleiiim ...
J'ai un peu de mal à comprendre l'objectif à la simple lecture du code
pourquoi ne tester que par rapport à WR.Cells(2, 2) c'est-à-dire la référence de la 2ème ligne ?
If .Cells(x, 1).Value = WR.Cells(2, 2).Value Thenet pourquoi 10 et 110 ?
WR.Cells(x, 2).Offset(0, 10) = WB.Cells(4, y)
WR.Cells(x, 2).Offset(0, 110) = WB.Cells(x, y)en écrasant du reste la dernière valeur recopiée ?
in fine quel est l'objectif de la macro ?
Re,
alors je reprends tout
J'ai testé qu'avec cette cellule juste à titre d'exemple,
et je me suis trompée ce n'est pas :
WR.Cells(x, 2).Offset(0, 10) = WB.Cells(4, y)
WR.Cells(x, 2).Offset(0, 110) = WB.Cells(x, y)Mais :
WR.Cells(x, 2).Offset(0, 10) = WB.Cells(4, y)
WR.Cells(x, 2).Offset(0, 11) = WB.Cells(x, y)En fait mon fichier d'origine est composée d'une centaine de colonnes et 14 000 lignes
Et je voudrais que les infos (non vides et <> 0) dans ma base se mettent dans ma feuille requête en face de la référence concernée.
Et mon test sur la cellule WR.Cells(2, 2) j'aimerais qu'il se fasse pour la cellule WR.Cells(3, 2), WR.Cells(4, 2)..... WR.Cells(14000, 2)
Le soucis aussi c'est que j'aimerais que lorsque la cellule du dessous est identique à celle du dessus, que le code ignore cette cellule.
Du coup mon ébauche de code pour le moment ressemble à ça (juste pour comprendre le principe) mais ça ne va pas car j'ai toutes ces conditions que je dois incrémenter. (voir fichier)
Sub importation()
Dim x As Variant
Dim y As Variant
Dim z As Variant
Dim i As Variant
Dim WB As Worksheet
Dim WR As Worksheet
Dim Réf As Variant
Set WB = ThisWorkbook.Worksheets("Base")
Set WR = ThisWorkbook.Worksheets("Requete Nomenclatures CLEM")
With WB
For x = 5 To .Range("A" & .Rows.Count).End(xlUp).Row
If .Cells(x, 1).Value = WR.Cells(2, 2).Value Then
For y = 2 To 7
If WB.Cells(x, y) <> 0 Then
WR.Cells(2, 2).Offset(0, 10) = WB.Cells(4, y)
WR.Cells(2, 2).Offset(0, 11) = WB.Cells(x, y)
End If
Next
End If
Next
End WithEst-ce que c'est plus clair ?
Peut-être que ce fichier avec cet autre code va t'aider à comprendre un peu mieux ce que je voudrai pour toutes mes références.
cleiiim
Salut Cleiiim,
Salut l'équipe,
c'est perturbant de ne pas avoir de correspondance entre les lignes de titres de colonnes entre les deux feuilles car j'imagine que les infos doivent correspondre...
On peut avoir l'ensemble des colonnes des deux feuilles?
A+
Salut Curulis57,
vu de l'extérieur c'est pas faux
Donc j'ai mis des intitulés et changé les infos pour que ça parle +
Voilà mon fichier avec le bout de code :
Cleiiim
Peut-être que ce fichier avec cet autre code va t'aider à comprendre un peu mieux ce que je voudrai pour toutes mes références.
Malheureusement, pas trop, non !
Et je n'ai toujours pas ma réponse :
pourquoi ne tester que par rapport à WR.Cells(2, 2) c'est-à-dire la référence de la 2ème ligne ?
in fine quel est l'objectif de la macro ?
Cleiiim, quelque chose me dit qu'il faudra te soumettre à la question!
Viens à notre place et demande-toi comment tu résous ça...
Alors, pour UNE référence, tu vas nous pondre un résultat espéré en 'Requête nomenclature' à partir de ta feuille 'BASE' en détaillant le pourquoi du comment!
Perso, sans autres précisions, je ne vois pas...
- 36 ingrédients et/ou quantités en 'BASE' mais 1 colonne INGREDIENTS ou QUANTITE ailleurs...
- 'NOM COMPOSANT' vient d'où ?
- ...
A+
Re,
Alors je prépare un nouveau fichier plus détaillé plus explicite
Ça sera sûrement mieux
Steelson, j’ai pris cette cellule juste pour vous montrer ce que j’aimerais avoir, mais je pense que ça vous a embrouillé plutôt qu’autre chose
Je reviens vers vous avec mon fichier
Cleiiim
Explique aussi avec des mots simples plus qu'avec un projet de macro ce que tu veux faire, à quoi tu veux arriver, quel est ton but, on pourra sans doute mieux conseiller.
je tente,
Donc je souhaite que mon code cherche chaque référence de ma colonne B de ma feuille Requête, dans la feuille Base colonne A.
Lorsqu’il a trouvé la référence dans la base, je veux que les intitulés en ligne 4 de ma base (lorsque le résultat est <> de 0) se mettent dans la colonne à côté de ma référence puis le reste en dessous.
Par exemple la référence B2 a été trouvé dans la base, je veux qu'en C2 puis C3,C4 ... les intitulés s'y mettent
Et ensuite je veux qu'en face des intitulés se mettent les quantités donc en D2,D3,D4
Si (x,y) <> 0
Cleiiim
Voilà un fichier (sans code) plus clair je pense
Qui permet de voir ce que j'aimerais
(j'ai pas mis mes 14000 lignes ni ma centaine de colonnes)
cleiiim
Re,
Alors j'ai réussi à faire mon code
il me reste un problème que je n'arrive pas à résoudre pour le moment.
Je vous joint le fichier avec la macro.
Donc mon code est le suivant :
Sub importation()
Dim x As Variant
Dim y As Variant
Dim z As Variant
Dim i As Variant
Dim WB As Worksheet
Dim WR As Worksheet
Dim Réf As Variant
Set WB = ThisWorkbook.Worksheets("Base")
Set WR = ThisWorkbook.Worksheets("Requete Nomenclatures CLEM")
For x = 3 To WR.Range("B" & WR.Rows.Count).End(xlUp).Row
For z = 5 To WB.Range("B" & WB.Rows.Count).End(xlUp).Row
If WR.Cells(x, 2).Value = WB.Cells(z, 2).Value Then
If WR.Cells(x, 2).Value <> WR.Cells(x - 1, 2).Value Then
With WB
For y = 3 To 53
If WB.Cells(z, y) <> 0 Then
For i = Range("tableau").Row To Range("tableau").Row + 178
If WR.Cells(i, 3) = "" Then
WR.Cells(i, 3) = WB.Cells(4, y)
WR.Cells(i, 4) = WB.Cells(z, y)
Exit For
End If
Next
End If
Next
End With
Exit For
End If
End If
Next
Next
End SubDonc mon problème est cette partie de mon code
For i = Range("tableau").Row To Range("tableau").Row + 178
If WR.Cells(i, 3) = "" Then
WR.Cells(i, 3) = WB.Cells(4, y)
WR.Cells(i, 4) = WB.Cells(z, y)
Exit For
End IfCar en fait mes ingrédients se mettent bien dans mon tableau mais pas forcément en face de la recette concernée.
Et si je fais ce code :
If WR.Cells(x, 3) = "" Then
WR.Cells(x, 2).Offset(0, 1) = WB.Cells(4, y)
WR.Cells(x, 2).Offset(0, 2) = WB.Cells(x, y)Seul le premier ingrédient se met puisqu'ensuite la cellule n'est plus vide. Et je ne sais pas comment lui dire d'aller en dessous si la cellule n'est pas vide.
Cleiiim
edit : je n'ai pas travaillé sur ton dernier post
Sub nomenclature()
Dim f1 As Worksheet, f2 As Worksheet, f3 As Worksheet
Set f1 = Sheets("Nomenclature")
Set f2 = Sheets("Requete Nomenclatures CLEM")
Set f3 = Sheets("Base")
Dim cel As Range
ligne = 2
f1.Range("A1").CurrentRegion.Offset(1, 0).ClearContents
For i = 2 To f2.Cells(Rows.Count, 1).End(xlUp).Row
Set cel = f3.Range("B5:B" & f3.Cells(Rows.Count, 2).End(xlUp).Row).Find(f2.Cells(i, 2))
If Not cel Is Nothing Then
For j = 3 To f3.Cells(4, Columns.Count).End(xlToLeft).Column
If f3.Cells(cel.Row, j) <> 0 Then
f1.Cells(ligne, 1) = f2.Cells(i, 1)
f1.Cells(ligne, 2) = f2.Cells(i, 2)
f1.Cells(ligne, 3) = f3.Cells(4, j)
f1.Cells(ligne, 4) = f3.Cells(cel.Row, j)
ligne = ligne + 1
End If
Next
Else
f1.Cells(ligne, 1) = f2.Cells(i, 1)
f1.Cells(ligne, 2) = f2.Cells(i, 2)
f1.Cells(ligne, 3) = "?"
f1.Cells(ligne, 4) = "?"
ligne = ligne + 1
End If
Next
f1.Select
End SubMerci Steelson pour ton retour,
le problème c'est que je ne peux pas travaillé sur une autre feuille
Puisque dans mon fichier original ces données doivent être comparées à d'autres données qui se trouvent dans des colonnes entre deux ...
Si tu pouvais jeter un œil à mon dernier poste ça m'arrangerai énormément
Merci
Cleiiim