Ajouter des données
Résolu
ctaveau
Messages postés
15
Date d'inscription
mardi 3 avril 2007
Statut
Membre
Dernière intervention
9 juillet 2007
-
3 avril 2007 à 12:24
ctaveau Messages postés 15 Date d'inscription mardi 3 avril 2007 Statut Membre Dernière intervention 9 juillet 2007 - 3 avril 2007 à 16:55
ctaveau Messages postés 15 Date d'inscription mardi 3 avril 2007 Statut Membre Dernière intervention 9 juillet 2007 - 3 avril 2007 à 16:55
5 réponses
ctaveau
Messages postés
15
Date d'inscription
mardi 3 avril 2007
Statut
Membre
Dernière intervention
9 juillet 2007
3 avril 2007 à 16:55
3 avril 2007 à 16:55
Oups le code de l'analyse d'une ligne
'
If Range("F7").Value = "O" Then
Range("A7:C7").Select
Selection.Copy
Sheets("Archive").Select
Range("A8:C8").Select > c'est ça que j'ai essayé de remplacer par le code
> Range("A" & Mid(ActiveSheet.UsedRange.Address, InStrRev(ActiveSheet.UsedRange.Address, "$") + 1)).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("PA Benoît").Select
Range("A3:F3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Archive").Select
Range("D8").Select > Idem
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("F1").Select
Application.CutCopyMode = False
Selection.Copy
Range("E8").Select > Idem
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("PA Benoît").Select
Range("A7:F7").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A1:F1").Select
End If
Cyril
'
If Range("F7").Value = "O" Then
Range("A7:C7").Select
Selection.Copy
Sheets("Archive").Select
Range("A8:C8").Select > c'est ça que j'ai essayé de remplacer par le code
> Range("A" & Mid(ActiveSheet.UsedRange.Address, InStrRev(ActiveSheet.UsedRange.Address, "$") + 1)).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("PA Benoît").Select
Range("A3:F3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Archive").Select
Range("D8").Select > Idem
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("F1").Select
Application.CutCopyMode = False
Selection.Copy
Range("E8").Select > Idem
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("PA Benoît").Select
Range("A7:F7").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A1:F1").Select
End If
Cyril
jrivet
Messages postés
7392
Date d'inscription
mercredi 23 avril 2003
Statut
Membre
Dernière intervention
6 avril 2012
60
3 avril 2007 à 14:16
3 avril 2007 à 14:16
Salut,
Oulaala,
Un petit conseil.lorsque tu vois des portions de codes qui te paresse faire strictement la meme chose avec seulement une petite différence (style le numéro de ligne) Il faudrait que tu penses à faire des procédures.
Le code suivant (NON TESTE) devrait faire la meme chose. mais c'ets juste pour montrer la manière de procéder.
Tu remarqueras qu'il reste encore du codes qui se répète et doinc encore de la simplification d'écriture possible.
Je pense que c'est plus simple à comprendre lorsqu'il n'y a pas 3 pages de code.
En ce qui concerne ta question il existe des codes dispo.
Mais déjà regarde ceci.
Il faudrait que tu réexplique un peu mieux car je n'ai pas compris là ou tu coinces.
Private Sub ProcessRange(ByVal NumLigne As Long)
Call ActiveSheet.Range("A" & CStr(NumLigne) & ":C" & CStr(NumLigne)).Select
Call Selection.Copy
Call ActiveWorkbook.Worksheets("Histo").Select
Call ActiveSheet.Range("A" & CStr(NumLigne - 1) & ":C" & CStr(NumLigne - 1)).Select
Call Selection.Range.PasteSpecial(xlValues, xlNone, False, False)
Call ActiveWorkbook.Worksheets("PA Benoit").Select
Call ActiveSheet.Range("A3:F3").Select
Application.CutCopyMode = False
Call Selection.Copy
Call ActiveWorkbook.Worksheets("Histo").Select
Call ActiveSheet.Range("D" & CStr(NumLigne) - 1).Select
Call Selection.Range.PasteSpecial(xlValues, xlNone, False, False)
Call ActiveWorkbook.Worksheets("PA Benoit").Select
Call ActiveSheet.Range("G1").Select
Application.CutCopyMode = False
Call Selection.Copy
Call ActiveWorkbook.Worksheets("Histo").Select
Call ActiveSheet.Range("E" & CStr(NumLigne - 1)).Select
Call Selection.Range.PasteSpecial(xlValues, xlNone, False, False)
Call ActiveWorkbook.Worksheets("PA Benoit").Select
Call ActiveSheet.Range("A" & CStr(NumLigne) & ":C" & CStr(NumLigne)).Select
Application.CutCopyMode = False
Call Selection.ClearContents
End Sub<hr />
Private Sub histo_bg()
' désactiver le rafraichissement de l'écran pour accélérer le traitement
Application.ScreenUpdating = False
' désactiver les alertes pour empêcher l'affichage
' des messages du genre "Voulez-vous etc."
Application.DisplayAlerts = False
Dim i As Long
For i = 7 To 17
If ActiveSheet.Range("F" & CStr(i)).Value = "O" Then Call ProcessRange(i)
Next
Exit Sub '=> ca te fait sortir de ta sub
'donc les deux lignes suivantes ne servent à rien
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub , ----
[code.aspx?ID=41455 By Renfield]
@+: Ju£i?n
Pensez: Réponse acceptée
Oulaala,
Un petit conseil.lorsque tu vois des portions de codes qui te paresse faire strictement la meme chose avec seulement une petite différence (style le numéro de ligne) Il faudrait que tu penses à faire des procédures.
Le code suivant (NON TESTE) devrait faire la meme chose. mais c'ets juste pour montrer la manière de procéder.
Tu remarqueras qu'il reste encore du codes qui se répète et doinc encore de la simplification d'écriture possible.
Je pense que c'est plus simple à comprendre lorsqu'il n'y a pas 3 pages de code.
En ce qui concerne ta question il existe des codes dispo.
Mais déjà regarde ceci.
Il faudrait que tu réexplique un peu mieux car je n'ai pas compris là ou tu coinces.
Private Sub ProcessRange(ByVal NumLigne As Long)
Call ActiveSheet.Range("A" & CStr(NumLigne) & ":C" & CStr(NumLigne)).Select
Call Selection.Copy
Call ActiveWorkbook.Worksheets("Histo").Select
Call ActiveSheet.Range("A" & CStr(NumLigne - 1) & ":C" & CStr(NumLigne - 1)).Select
Call Selection.Range.PasteSpecial(xlValues, xlNone, False, False)
Call ActiveWorkbook.Worksheets("PA Benoit").Select
Call ActiveSheet.Range("A3:F3").Select
Application.CutCopyMode = False
Call Selection.Copy
Call ActiveWorkbook.Worksheets("Histo").Select
Call ActiveSheet.Range("D" & CStr(NumLigne) - 1).Select
Call Selection.Range.PasteSpecial(xlValues, xlNone, False, False)
Call ActiveWorkbook.Worksheets("PA Benoit").Select
Call ActiveSheet.Range("G1").Select
Application.CutCopyMode = False
Call Selection.Copy
Call ActiveWorkbook.Worksheets("Histo").Select
Call ActiveSheet.Range("E" & CStr(NumLigne - 1)).Select
Call Selection.Range.PasteSpecial(xlValues, xlNone, False, False)
Call ActiveWorkbook.Worksheets("PA Benoit").Select
Call ActiveSheet.Range("A" & CStr(NumLigne) & ":C" & CStr(NumLigne)).Select
Application.CutCopyMode = False
Call Selection.ClearContents
End Sub<hr />
Private Sub histo_bg()
' désactiver le rafraichissement de l'écran pour accélérer le traitement
Application.ScreenUpdating = False
' désactiver les alertes pour empêcher l'affichage
' des messages du genre "Voulez-vous etc."
Application.DisplayAlerts = False
Dim i As Long
For i = 7 To 17
If ActiveSheet.Range("F" & CStr(i)).Value = "O" Then Call ProcessRange(i)
Next
Exit Sub '=> ca te fait sortir de ta sub
'donc les deux lignes suivantes ne servent à rien
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub , ----
[code.aspx?ID=41455 By Renfield]
@+: Ju£i?n
Pensez: Réponse acceptée
ctaveau
Messages postés
15
Date d'inscription
mardi 3 avril 2007
Statut
Membre
Dernière intervention
9 juillet 2007
3 avril 2007 à 15:07
3 avril 2007 à 15:07
Ok, j'ai bien vu le message. Je sais que ce code n'est pas optimisé ni très conforme à ce que l'on peut attendre.
M'enfin, j'ai apprécié le conseil mais n'est malheureuseusement pas le temps de tous boulverser.
J'ai essayé le code, et ça bogue avec le débogueur qui signale un pb sur la ligne
Call Selection.Range.PasteSpecial(xlValues, xlNone, False, False)
mais ce n'est pas trop grave, pas plus de message que ça. Dans l'immédiat je vais essayer de reprendre à zéro la macro initiale.
Le truc c'est que je connais vraiment pas VBA. Donc je vais utiliser les quelques actuces que j'ai glaner à chercher une solution à mon pb.
Là où je coincais, c'était lors de la copie des éléments de PA Benoit pour Histo, de me placer sur la première ligne vide de ce tableau archive dans le feuille Histo à chaque nouvelle copie de ligne
(feuille)PA Benoit (feuille)Histo
ligne 1.---------- O ligne 1.---------- O
ligne 2.---------- O
ligne 2.---------- O
ligne 3.----------N
ligne 4.---------- O
ligne 4.---------- O
ligne 5.---------- N
(O et N représentent le critère de sélection > le but est d'obtenir au fil du temps un tableau complet cumulant les lignes en dessous des une des autres)
Et dernier truc, à faire, est après ceci, optimiser le tableau d'origine, en réunissant les données sur le haut, sans laisser de ligne vide entre les complètes.
Obtenir et pas
(feuille)PA Benoit (feuille)PA Benoit
ligne 3.----------N
ligne 5.---------- N ligne 3.----------N
ligne 5.----------N
Merci
Cyril
M'enfin, j'ai apprécié le conseil mais n'est malheureuseusement pas le temps de tous boulverser.
J'ai essayé le code, et ça bogue avec le débogueur qui signale un pb sur la ligne
Call Selection.Range.PasteSpecial(xlValues, xlNone, False, False)
mais ce n'est pas trop grave, pas plus de message que ça. Dans l'immédiat je vais essayer de reprendre à zéro la macro initiale.
Le truc c'est que je connais vraiment pas VBA. Donc je vais utiliser les quelques actuces que j'ai glaner à chercher une solution à mon pb.
Là où je coincais, c'était lors de la copie des éléments de PA Benoit pour Histo, de me placer sur la première ligne vide de ce tableau archive dans le feuille Histo à chaque nouvelle copie de ligne
(feuille)PA Benoit (feuille)Histo
ligne 1.---------- O ligne 1.---------- O
ligne 2.---------- O
ligne 2.---------- O
ligne 3.----------N
ligne 4.---------- O
ligne 4.---------- O
ligne 5.---------- N
(O et N représentent le critère de sélection > le but est d'obtenir au fil du temps un tableau complet cumulant les lignes en dessous des une des autres)
Et dernier truc, à faire, est après ceci, optimiser le tableau d'origine, en réunissant les données sur le haut, sans laisser de ligne vide entre les complètes.
Obtenir et pas
(feuille)PA Benoit (feuille)PA Benoit
ligne 3.----------N
ligne 5.---------- N ligne 3.----------N
ligne 5.----------N
Merci
Cyril
jrivet
Messages postés
7392
Date d'inscription
mercredi 23 avril 2003
Statut
Membre
Dernière intervention
6 avril 2012
60
3 avril 2007 à 15:39
3 avril 2007 à 15:39
Salut,
Désolé j'ai oublier d'enlever .Range
Cela doit etre
Call Selection.PasteSpecial(xlValues, xlNone, False, False) a chaque fois que nécessaire, pas besoin du range.
Ok je comprend mieux, voyons voir si ce code peu t'aider.
le code quivant copie le contenu de AxCx dans depuis la feuille PA Benoit vers la feuille Histo. SI Fx contient O
Puis une fois copier il supprime la ligne d'origine
Dim i As Integer
'Nous devons partir de la fin pour le
'décalge vers le haut
Dim LigneHisto As Long
LigneHisto = 1
For i = 17 To 7 Step -1
If ActiveSheet.Range("F" & CStr(i)).Value = "O" Then
Call ActiveSheet.Range("A" & CStr(i) & ":C" & CStr(i)).Cut
Call ActiveWorkbook.Worksheets("Histo").Range("A" & LigneHisto).Insert(xlDown)
Call ActiveSheet.Rows(CStr(i)).Delete(xlUp)
LigneHisto = LigneHisto + 1
End If
Next, ----
[code.aspx?ID=41455 By Renfield]
Voila j'espère que ca t'aide
@+: Ju£i?n
Pensez: Réponse acceptée
Désolé j'ai oublier d'enlever .Range
Cela doit etre
Call Selection.PasteSpecial(xlValues, xlNone, False, False) a chaque fois que nécessaire, pas besoin du range.
Ok je comprend mieux, voyons voir si ce code peu t'aider.
le code quivant copie le contenu de AxCx dans depuis la feuille PA Benoit vers la feuille Histo. SI Fx contient O
Puis une fois copier il supprime la ligne d'origine
Dim i As Integer
'Nous devons partir de la fin pour le
'décalge vers le haut
Dim LigneHisto As Long
LigneHisto = 1
For i = 17 To 7 Step -1
If ActiveSheet.Range("F" & CStr(i)).Value = "O" Then
Call ActiveSheet.Range("A" & CStr(i) & ":C" & CStr(i)).Cut
Call ActiveWorkbook.Worksheets("Histo").Range("A" & LigneHisto).Insert(xlDown)
Call ActiveSheet.Rows(CStr(i)).Delete(xlUp)
LigneHisto = LigneHisto + 1
End If
Next, ----
[code.aspx?ID=41455 By Renfield]
Voila j'espère que ca t'aide
@+: Ju£i?n
Pensez: Réponse acceptée
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
ctaveau
Messages postés
15
Date d'inscription
mardi 3 avril 2007
Statut
Membre
Dernière intervention
9 juillet 2007
3 avril 2007 à 16:51
3 avril 2007 à 16:51
Ok, j'ai bien vu le code, fait les modifs qu'il fallait, mais ça ne me ressort rien. A mon avis je ne m'y connais pas assez en VBA pour trop triturer ces codes.
Enfin, je reprends simple, j'ai une feuille 'PA Benoît' et une feuille 'Archive'. La feuille PA Benoît sert à la saisie (double tableau l'un sur l'autre de 5 colonnes sur 2 fois 11 lignes), remplie au fur à mesure, le dernier critère sert à la Clôture (Oui ou Non) de l'évènement (1 évènement / ligne). La feuille archive reprend une partie de ces critères, plus deux autres (nom et date) selon la condition de cloture.
Ce que je recherche, c'est une macro qui regarde tous ces lignes sur PA Benoît > c'est pour ça que la macro est répétée
qui selon une condition Cloturé > transfert ligne par ligne les éléments qu'il faut plus le nom et la date
ensuite nettoie le reste des infos sur les lignes en partie archivée
Jusqu'à là je me suis débrouillé avec les aides et codes en lignes.
Voici un extrait du code pour une ligne
'
Mais là où ça bloque c'est sur le transfert sur la feuille archive. Au début j'ai fait la macro à la main pour une ligne, copié ligne par ligne.
Ajouté la condition avec If
puis chercher une solution pour savoir où écrire dans le tableau archive et essaie différentes solutions.
La solution la plus simple était de remplacer
Range("A8.C8").Select >>> qui sert à pointer la ligne dans archive
par
Range("A" & Mid(ActiveSheet.UsedRange.Address, InStrRev(ActiveSheet.UsedRange.Address, "$") + 1)).Offset(1, 0).Select
qui devrait normalement me pointer la première ligne vide dans le tableau archive à chaque coup dans la colonne A
mais où que j'ai coincé, c'est que je ne sais pas exactement pourquoi, mais lorque j'ai fait ces essais, je pensai au début que ça ne fonctionnait pas alors que si, mais le tableau archive, même vide est considéré comme plein, et je me retourve avec les valeurs collées totalement en bas du cadre prévu du tableau archive. Bizarre???
La finalité, est que j'ai plusieurs feuilles de type PA, et qu'ensuite je duplique cette macro sur chaque feuille, pour avoir au final une archive les regroupant tous.
Donc ce qu'il me manque, c'est une solution pour positionner sur la dernière ligne du tableau, dans le tableau bien sûr.
Et autrement une fois le transfert fait, d'avoir la feuille PA d'origine qui se 'recondense' proprement. Les lignes effacées, ça c'est OK, mais comment ramener toutes lignes les une sous les autres et avoir toujours un total de 11 lignes (pleines et vides) par tableau x 2.
Donc est-ce que quelqu'un saurait m'expliquer ou m'aider à interpréter cette ligne svp ?
Range("A" & Mid(ActiveSheet.UsedRange.Address, InStrRev(ActiveSheet.UsedRange.Address, "$") + 1)).Offset(1, 0).Select
et comprendre pourquoi elle se met en dessous de mon tableau, alors qu'il est bien vide. Il n'y a que les bordures et la mise en forme de faites.
J'ai essayé d'être le plus clair possible. N'hésitez pas à me redemander des précisions.
Merci
Cyril
Enfin, je reprends simple, j'ai une feuille 'PA Benoît' et une feuille 'Archive'. La feuille PA Benoît sert à la saisie (double tableau l'un sur l'autre de 5 colonnes sur 2 fois 11 lignes), remplie au fur à mesure, le dernier critère sert à la Clôture (Oui ou Non) de l'évènement (1 évènement / ligne). La feuille archive reprend une partie de ces critères, plus deux autres (nom et date) selon la condition de cloture.
Ce que je recherche, c'est une macro qui regarde tous ces lignes sur PA Benoît > c'est pour ça que la macro est répétée
qui selon une condition Cloturé > transfert ligne par ligne les éléments qu'il faut plus le nom et la date
ensuite nettoie le reste des infos sur les lignes en partie archivée
Jusqu'à là je me suis débrouillé avec les aides et codes en lignes.
Voici un extrait du code pour une ligne
'
Mais là où ça bloque c'est sur le transfert sur la feuille archive. Au début j'ai fait la macro à la main pour une ligne, copié ligne par ligne.
Ajouté la condition avec If
puis chercher une solution pour savoir où écrire dans le tableau archive et essaie différentes solutions.
La solution la plus simple était de remplacer
Range("A8.C8").Select >>> qui sert à pointer la ligne dans archive
par
Range("A" & Mid(ActiveSheet.UsedRange.Address, InStrRev(ActiveSheet.UsedRange.Address, "$") + 1)).Offset(1, 0).Select
qui devrait normalement me pointer la première ligne vide dans le tableau archive à chaque coup dans la colonne A
mais où que j'ai coincé, c'est que je ne sais pas exactement pourquoi, mais lorque j'ai fait ces essais, je pensai au début que ça ne fonctionnait pas alors que si, mais le tableau archive, même vide est considéré comme plein, et je me retourve avec les valeurs collées totalement en bas du cadre prévu du tableau archive. Bizarre???
La finalité, est que j'ai plusieurs feuilles de type PA, et qu'ensuite je duplique cette macro sur chaque feuille, pour avoir au final une archive les regroupant tous.
Donc ce qu'il me manque, c'est une solution pour positionner sur la dernière ligne du tableau, dans le tableau bien sûr.
Et autrement une fois le transfert fait, d'avoir la feuille PA d'origine qui se 'recondense' proprement. Les lignes effacées, ça c'est OK, mais comment ramener toutes lignes les une sous les autres et avoir toujours un total de 11 lignes (pleines et vides) par tableau x 2.
Donc est-ce que quelqu'un saurait m'expliquer ou m'aider à interpréter cette ligne svp ?
Range("A" & Mid(ActiveSheet.UsedRange.Address, InStrRev(ActiveSheet.UsedRange.Address, "$") + 1)).Offset(1, 0).Select
et comprendre pourquoi elle se met en dessous de mon tableau, alors qu'il est bien vide. Il n'y a que les bordures et la mise en forme de faites.
J'ai essayé d'être le plus clair possible. N'hésitez pas à me redemander des précisions.
Merci
Cyril