Décalage copie colonnes + Optimisation
Bonjour à tous,
Je bosse actuellement sur une macro qui doit permettre d’extraire facilement et d’analyser des données depuis une base de donnée.
Afin de réaliser des graphs rapidement, je souhaite extraire des valeurs dans des colonnes ciblées, à partir de conditions initiales (fonction if au début du code).
J’ai pour l’instant ce bout de code, qui fonctionne quasiment :
For NoLig = 7 To DerLig
If Sheets("PdS_Géom").Range("A" & NoLig).Value = "CONSTRUCTEUR" And Sheets("PdS_Géom").Range("E" & NoLig).Value = "Type1" Then
colonne = 1
DLig = Sheets("Datas graphs").Cells(Rows.Count, colonne).End(xlUp).Row + 1
'Copie des valeurs SOP (colonne D)
Sheets("PdS_Géom").Select
Range("D" & NoLig).Select
Selection.Copy
Sheets("Datas graphs").Select
Cells(DLig, colonne).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
colonne = 2
DLig = Sheets("Datas graphs").Cells(Rows.Count, colonne).End(xlUp).Row + 1
'Copie des valeurs Pspec (colonne K)
Sheets("PdS_Géom").Select
Range("K" & NoLig).Select
Selection.Copy
Sheets("Datas graphs").Select
Cells(DLig, colonne).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ElseIf Sheets("PdS_Géom").Range("A" & NoLig).Value = "CONSTRUCTEUR" And Sheets("PdS_Géom").Range("E" & NoLig).Value = "Type2" Then
ElseIf Sheets("PdS_Géom").Range("A" & NoLig).Value <> "CONSTRUCTEUR" And Sheets("PdS_Géom").Range("E" & NoLig).Value = "Type1" Then
ElseIf Sheets("PdS_Géom").Range("A" & NoLig).Value <> "CONSTRUCTEUR" And Sheets("PdS_Géom").Range("E" & NoLig).Value = "Type2" Then
End If
Next
Actuellement : la macro trouve bien toutes les valeurs que je souhaite, et les copie bien dans la première ligne vide de la colonne associée sur le tableau de synthèse (feuille Datas graphs).
Le seul souci : si une valeur n’est pas renseignée, cela créé un décalage, puisque le code écrit dans la première ligne vide.
Comment faire en sorte que chaque valeur se retrouve forcément face à la colonne associée ? (Dans le but de pouvoir créer ensuite un graph nuage de points facilement).
Aussi, étant débutant en VBA, j’imagine que le code n’est pas optimisé, et je trouve le temps de travail relativement long en vue de la taille actuelle du fichier.
A terme la base de donnée va être beaucoup plus remplie, donc si vous avez des idées pour m’aider à améliorer le temps de réponse, je suis preneur.
Sachant que vu comme est parti le code, il va falloir le repéter ou en tout cas l'appeler pour chaque condition "if" + refaire la meme chose pour chaque graphique.
Merci à vous
Ok, donc en enlevant la ligne
DLig = Sheets("Datas graphs").Cells(Rows.Count, colonne).End(xlUp).Row + 1
Pour la colonne 2, il ne me copie que les valeurs où les 2 champs sont renseignés, du coup chaque valeur se retrouve en face de celle qui lui est associée.
J'aimerais cependant pouvoir copier l'intégralité des valeurs, meme les cellules vides.
Bonjour
Une idée mais sans fichier pour tester pas glop
Sub Test()
Dim DLig As Long, NoLig As Long
DLig = 7 ' Définir la 1ère ligne dans la page "Datas graphs"
With Sheets("PdS_Géom")
For NoLig = 7 To DerLig
If .Range("A" & NoLig).Value = "CONSTRUCTEUR" Then
If .Range("E" & NoLig).Value = "Type1" Then
'Copie des valeurs SOP (colonne D)
Sheets("Datas graphs").Cells(DLig, "A") = .Range("D" & NoLig)
Sheets("Datas graphs").Cells(DLig, "B") = .Range("K" & NoLig)
DLig = DLig + 1
ElseIf .Range("E" & NoLig).Value = "Type2" Then
End If
Else ' Cas : <> "CONSTRUCTEUR"
If .Range("E" & NoLig).Value = "Type1" Then
ElseIf .Range("E" & NoLig).Value = "Type2" Then
End If
End If
Next NoLig
End With
End Sub
Bonjour Adddesign, bonjour le forum,
C'est quelle valeur qui ne serait pas renseignée ? Celle de la colonne "CONSTRUCTEUR" ou celle de la colonne "TYPE" ? j'avoue que ce n'est pas très clair... J'ai commencé à revoir ton code avec des Select Case à la place des ElseIf. Ce n'est pas plus rapide mais c'est plsu clair (pour moi en tous cas)...
Sub Macro1()
Dim P As Worksheet
Dim D As Worksheet
Set P = Sheets("PdS_Géom")
Set D = Sheets("Datas graphs")
For NoLig = 7 To DerLig
Select Case P.Cells(NoLig, 1).Value
Case "CONSTRUCTEUR"
Select Case P.Cells(NoLig, 5).Value
Case "Type1"
For colonne = 1 To 2
DLig = D.Cells(Application.Rows.Count, colonne).End(xlUp).Row + 1
P.Cells(NoLig, 4).Copy
D.Cells(DLig, colonne).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next colonne
Case "Type2"
End Select
Case Else
Select Case P.Cells(NoLig, 5).Value
Case "Type1"
Case "Type2"
End Select
End Select
Next NoLig
End Sub
Merci beaucoup pour vos réponses.
Désolé pour le manqué de fichier, mais c'est un Excel que je réalise pour le boulot et je ne peux pas partager les données qu'il contient. Je vais faire au mieux pour expliquer.
En adaptant un petit peu, vos deux solutions fonctionnent, merci beaucoup
Cependant celle de Banzai tourne plus vite je vais donc m'orienter vers celle ci
Juste deux petits soucis :
- Lorsqu'une ligne dans la base de donnée (feuille PdS_Géom) ne répond pas aux conditions constructeur et type, une ligne vide se crée dans la page de synthèse (Datas graphs). Comment puis-je faire pour éviter ceci ?
- Pour élargir le code pour les autres types et / ou constructeur, je souhaiterai en gros le meme fonctionnement, en écrivant dans les colonnes suivantes sur la feuille Datas graphs.
J'ai donc copié le morceau de code dans la seconde partie :
Et là petit souci : la macro écrit bien dans les colonnes souhaitées, mais je ne parviens pas à reprendre le comptage des lignes à partir de la ligne 4 (première ligne de la feuille Datas graphs). Du coup : si les colonnes A et B sur la feuille Datas graphs vont jusqu'à la ligne 126, l'écriture dans les colonnes C et D se fera à partir de la 127.
Je ne vois pas où remettre DLig à 4 dans la boucle sans tout foutre en l'air
En tout cas merci énormément pour votre aide
Quoique, il semble que j'ai dit une bêtise pour l'écriture des colonnes C et D à partir de la première ligne
On dirait simplement que c'est le meme souci que pour les colonnes A et B : meme les lignes qui ne respondent pas au critères constructeur et type sont prises en compte et copies.
Dans la colonne B on peut voir 9 lignes entre les valeurs 40 et 91, qui correspondent à des valeurs "Type 1".
Or, dans la base de données, ces 9 lignes sont remplies avec des valeurs "Type 2"
Bonjour
addesign a écrit :- Lorsqu'une ligne dans la base de donnée (feuille PdS_Géom) ne répond pas aux conditions constructeur et type, une ligne vide se crée dans la page de synthèse (Datas graphs). Comment puis-je faire pour éviter ceci ?
C'est bien toi qui avait demandé
addesign a écrit :Comment faire en sorte que chaque valeur se retrouve forcément face à la colonne associée ?
Surement que je n'ai pas compris ton souhait
addesign a écrit :Dans la colonne B on peut voir 9 lignes entre les valeurs 40 et 91, qui correspondent à des valeurs "Type 1".
Or, dans la base de données, ces 9 lignes sont remplies avec des valeurs "Type 2"
Pourquoi pas, mais as tu vérifié la condition "CONSTRUCTEUR", c'est peut-être normal ?
Ça il n'y a que toi qui le voit
Sans fichier pas possible de trouver une solution
Tu anonymises ton fichier et tu le joins
Indiques y ce que tu veux exactement comme tableau
Yes, désolé la prochaine fois je ferai en sorte de joindre le fichier directement
J'ai réussi à faire exactement ce que je souhaitais en partant de ton code, juste en rajoutant une variable DLig proper à chaque colonne
Du coup voici le code final :
Dim DLig, DLig2, DLig3, DLig4 As Long, NoLig As Long
DLig = 4 ' Définir la 1ère ligne dans la page "Datas graphs"
DLig2 = 4
DLig3 = 4
DLig4 = 4
With Sheets("PdS_Géom")
For NoLig = 7 To DerLig
If .Range("A" & NoLig).Value = "CONSTRUCTEUR" Then
If .Range("E" & NoLig).Value = "Type1" Then
Sheets("Datas graphs").Cells(DLig, "A") = .Range("D" & NoLig)
Sheets("Datas graphs").Cells(DLig, "B") = .Range("K" & NoLig)
DLig = DLig + 1
ElseIf .Range("E" & NoLig).Value = "Type2" Then
Sheets("Datas graphs").Cells(DLig2, "C") = .Range("D" & NoLig)
Sheets("Datas graphs").Cells(DLig2, "D") = .Range("K" & NoLig)
DLig2 = DLig2 + 1
End If
Else ' Cas : <> "CONSTRUCTEUR"
If .Range("E" & NoLig).Value = "Type1" Then
Sheets("Datas graphs").Cells(DLig3, "E") = .Range("D" & NoLig)
Sheets("Datas graphs").Cells(DLig3, "F") = .Range("K" & NoLig)
DLig3 = DLig3 + 1
ElseIf .Range("E" & NoLig).Value = "Type2" Then
Sheets("Datas graphs").Cells(DLig4, "G") = .Range("D" & NoLig)
Sheets("Datas graphs").Cells(DLig4, "H") = .Range("K" & NoLig)
DLig4 = DLig4 + 1
End If
End If
Next NoLig
End With
Un énorme merci à toi .. En quelques minutes tu as fait 50 fois mieux que moi en 2 jours
Bon après midi