Macro Excel

Question

Je reviens avec un petit souci, vous pouvez m'expliquer un peu ce qui fait cette formule. Selection.AutoFilter Field:=35, Criteria1:="=*PROD*", Operator:=xlOr, _ Criteria2:="=*INTL*" merci d'avance a+...

Nad-Dan · Answer

Il s'agit d'une instruction de macro qui effectue un filtre automatique dans la colonne 35 et ce, sur les critères PROD et INTL. C'est en fait le filtre personnalisé que tu trouves en utilisant le filtre automatique du menu/donnée/filtre A bientôt Dan...

Nad-Dan · Answer

Re, Bien entendu. Il n'y pas de pb. A te lire Dan...

Nad-Dan · Answer

Re,

Laisse moi du temps là car cette macro peut être simplifiée. Il y a trop d'instructions qui ne serve à rien

Avant ceci --> ' création d'une feuille et copie des ligne 1 à 5 de la feuille by company-details dans Feuil1

Mets ce code :

 Sub Macro_DAILY_Incidents()
 '
 ' Macro_DAILY_Incidents Macro
 ' Macro enregistrée le 15/02/2006 par dzxvxn
 ' Touche de raccourci du clavier: Ctrl+a
 '
 Range("A7:A100").ClearContents 'on supprime les données des cellules A7 et A100
 Sheets("company-details").Name = "by company-details" 'on renomme la feuille "company-details"
 Sheets("by company-details").Move Before:=Sheets(1) 'on déplace la feuille "by company details en premier

Après ajoute --> ' création d'une feuille et copie des ligne 1 à 5 de la feuille by company-details dans Feuil1

 Sheets.Add.Name = "group assigned-status" 'on ajoute une feuille nommée group assigned Status
 Sheets("by company-details").Select 'on sélectionne la feuille company...
 Rows("1:5").Copy Destination:=Sheets(1).Range("A1") 'on copie les lignes de la feuille company vers la première feuille du classeur qui est group assigned-status

Je continue cela un peu plus tard dans la journée.

Si tu pouvais mettre ton fichier ce serait bien.

A+

Dan

Nad-Dan · Answer

Re,

Dans la série d'instructions entre les deux premières lignes d'astérisque, peux tu me dire sur quellle feuille tu es et ce que tu veux faire.

Je vois que tu filtres et puis que tu copies de la feuille "group assigned" vers la feuille "by company".

Là je ne comprends plus rien à ce que tu veux faire pusiqu'avant tu fais le contraire en copiant les lignes 1 à 5 de la feuille "by company vers la feuille "group assigned

Difficile de t'aider là sans savoir ce que tu dois effectuer dans cette appli.

Tu peux expliquer ?

Merci

Dan

Nad-Dan · Answer

Re, Peut-être n'as-tu besoin que des explications de chaque instruction alors ? Une chose que je peux te dire c'est que ce code a été effectué avec l'enregistreur automatique d'Excel que tu trouves dans menu/outils/macro/nouvelle macro. en utilisant cet outil, tu peux créer une macro facielement mais les codes doivent être simplifiés pour gagner en rapidité. A te lire Dan...

Nad-Dan · Answer

Re,

voici une explication des mots que tu trouves dans ta macro. La plupart y sont. vois aussi l'aide excel dans VBA qui te donne des explications bien meilleures encore.

Range : equivaut à une cellule ou ue plage de cellule

Select : instruction quand tu sélectionnes une cellule ou plusieurs cellules

Sheets : pour nommer une feuille (sheets('by company)

Add : instruction pour ajouter

Copy : copier une sélection, une feuille

Activesheet : la feuille active – donc celle que tu vois de ton classeur

Paste : coller ce que tu as copié précédemment

Name : instruction pour nommer une plage, une feuille (activesheet.name = "tat") ; on donne le nom tat à la feuille active

Selection.Delete Shift:=xlUp : on supprime la sélection et o fait remonter les cellules vers la haut de la feuille

Cells : équivaut à toutes les cellules de la feuille

Application.CutCopyMode = False : supprime l'action de copier – coller

Clearcontents : supprimer le contenu des cellules (pas les formules )

ActiveWorkbook.RefreshAll : actualiser les données des TCD

On error goto : vois l'aide excel à ce sujet, ce sera plus facile

Close : fermer un classeur (activeworkbook.close -> fermer le classeur actif)

Msgbox : boite à message

Chdir : donne le répertoire

Dim : utilisé pour déclarer les variables

A bientôt

Dan

Gorfael · Answer

Sub Macro_DAILY_Incidents() Range("A7:A100").Select Selection.ClearContents 'Sur la feuille en cours effacer les cellules A7:A100 Range("A6").Select 'sert à rien Sheets("company-details").Select Sheets("company-details").Name = "by company-details" 'renommer "company-details" en "by company-details" Range("A6").Select 'sert à rien Sheets("by company-details").Select Sheets("by company-details").Move Before:=Sheets(1) 'déplacer la feuille renommée en 1re position Sheets("by company-details").Select Sheets("by company-details").Select 'pfff que de select inutiles Sheets.Add 'créer une feuille en 1re place dans le classeur Sheets("by company-details").Select Rows("1:5").Select Selection.Copy Sheets("Feuil1").Select Range("A1").Select ActiveSheet.Paste 'y coller les lignes 1 à 5 de la feuille "by company-details" 'à partir de la ligne 1 Rows("5:5").Select 'sert à rien Sheets("Feuil1").Select Sheets("Feuil1").Name = "group assigned-status" 'renommer la nouvelle feuille "group assigned-status" Range("A1").Select 'sert à rien Rows("3:3").Select Selection.Delete Shift:=xlUp 'supprimer la ligne 3 de "group assigned-status" Sheets("group assigned-status").Select Sheets("group assigned-status").Move After:=Sheets(2) 'mettre la feuille "group assigned-status" en 2me position Sheets("by company-details").Select 'sélectionner la feuille "by company-details" Range("A6").Select 'sert à rien ' Suppression des lignes 1 à 4 et 2 des colonnes citées ci dessous ' Rows("1:4").Select Selection.Delete Shift:=xlUp 'Supprimer les lignes 1 à 4 de "by company-details" Rows("2:2").Select Selection.Delete Shift:=xlUp 'supprimer la ligne 2 (ex n°6) Range("A2").Select 'sert à rien Selection.AutoFilter Field:=35, Criteria1:="=*PROD*", Operator:=xlOr, _ Criteria2:="=*INTL*" 'filtrer "by company-details" avec comme critère : 'la cellule AI de la ligne contient soit "PROD" soit "INTL" Cells.Select 'sélectionner les cellules filtrées Application.CutCopyMode = False 'sert à rien Selection.Delete Shift:=xlUp 'supprimer la sélection Rows("1:1").Select 'sert à rien Sheets("group assigned-status").Select Rows("4:4").Select Selection.Copy 'copier la ligne 4 de "group assigned-status" (ex-ligne 5) Sheets("by company-details").Select Rows("1:1").Select Selection.Insert Shift:=xlDown 'l'inserrer en ligne 1 de "by company-details" Range("A1").Select 'sert à rien Application.CutCopyMode = False 'sert à rien Selection.AutoFilter 'supprimer l'auto-filtre précédent Range("AI1").Select Selection.AutoFilter Field:=35, Criteria1:="=*Rolls*" Cells.Select Range("AE1").Activate Selection.Delete Shift:=xlUp 'supprimer les lignes dont AI contient "Rolls" Sheets("group assigned-status").Select Rows("4:4").Select Selection.Copy Sheets("by company-details").Select Rows("1:1").Select Range("AE1").Activate 'sert à rien Selection.Insert Shift:=xlDown 'remettre les titres qu'on vient encore de supprimer Range("A1").Select 'sert à rien Sheets("group assigned-status").Select Rows("4:4").Select Application.CutCopyMode = False 'sert à rien Selection.ClearContents 'effacer la ligne 4 de "group assigned-status" Range("A1").Select 'sert à rien Sheets("by company-details").Select 'sert à rien '**************************************************************************** Sheets(Array("by company-details", "group assigned-status")).Select 'sert à rien Sheets("by company-details").Activate Cells.Select Selection.Copy Windows("tdbJCD_DWRagOpen_aaaammjj.eds.xlt").Activate Cells.Select ActiveSheet.Paste 'copier le contenu de "by company-details" dans la feuille active du modèle ?!? Range("A1").Select 'sert à rien '************************************************************************************** Cells.Select ActiveSheet.Paste 'on vient de le faire ! On a affaire à un bégue (^_^) Range("A2").Select 'sert à rien ActiveWindow.ScrollWorkbookTabs Position:=xlFirst 'rend visible le 1er onglet du classeur modèle Sheets("by group assigned-SLA status").Select Range("C2").Select ' on active C2 de "by group assigned-SLA status" Sheets("by company-details").Select Range("A1").Select 'sert à rien ActiveWindow.ScrollWorkbookTabs Position:=xlFirst 'idem au-dessus : donc le premier sert à rien Sheets("by group assigned-SLA status").Select Application.CutCopyMode = False 'sert à rien ActiveWorkbook.RefreshAll 'actualisation des TCD et liaisons externes Range("D2").Select 'sert à rien '***************************************************************************************** ' Sauvegarde du fichier Dim dateactuelle As Date Dim mois As Integer Dim varmois As String Dim recupdate, nomfic As String 'déclaration (au mauvais endroit) On Error GoTo gerErrSauv 'si Excel détecte une erreur il va à l'adresse gerErrSauv annee = Year(Date) 'variable = année système strfilepath = "\FRBMSBUR041	db$\Jcd\Client\Daily_Report\" 'chemin de sauvegarde ? dateactuelle = Date 'variable = date système recupdate = Year(dateactuelle) &amp; Month(dateactuelle) &amp; Day(dateactuelle) 'chaine de texte non maitrisée : année+mois+jour '11 janvier 2007 =&gt; 2007111 '1 novembre 2007 =&gt; 2007111 ' si la valeur jour est sur un caractère If Len(Day(dateactuelle)) = 1 Then recupdate = Left(recupdate, Len(recupdate) - 1) + "0" + Right(recupdate, 1) End If 'si la valeur mois est sur un caractère If Len(Month(dateactuelle)) = 1 Then recupdate = Left(recupdate, Len(recupdate) - 3) + "0" + Right(recupdate, 3) End If 'remise en forme tardive (^_^). Meilleur : 'recupdate = Format(dateactuelle, "yyyy") &amp; Format(dateactuelle, "mm") &amp; Format(dateactuelle, "dd") nomfic = "tdbJCD_DWRagOpen " &amp; recupdate &amp; ".eds.xls" 'création du nom ChDir strfilepath 'sert à rien ActiveWorkbook.SaveAs Filename:=strfilepath &amp; nomfic, FileFormat:=xlNormal 'Sauvegarde du fichier 'dans le dossier : strfilepath 'sous le nom : nomfic ActiveWorkbook.Close ActiveWorkbook.Close 'fermer les 2 classeurs Exit Sub 'sortir avant la gestion des erreurs gerErrSauv: 'adresse de gestion des erreurs Excel MsgBox "erreur dans la sauvegarde du fichier " &amp; Chr(10) &amp; Chr(13) &amp; Err.Number &amp; " " &amp; Err.Description 'message d'erreur 'MsgBox Err.Number &amp; " " &amp; Err.Description, vbCritical + vbOKOnly, "ERREUR DANS LA SAUVEGARDE DU FICHIER" End Sub Commentaire corrosif Macro faite à l(aide de l'enregistreur macro et, si elle a fait l'objet de complêments, n'a pas été optimisée Quelques principes pour ce genre de macro : on sépare les actions : Déclarations : toutes, et en tête de macro (même si on fusionne plusieurs macros) copier/coller : ok (plus ou moins) mise en forme feuille collée mise en forme feuille copiée sauvegarde sous un autre nom fermeure Gestion de toutes les erreurs Excel Dans ton code, on navigue d'une feuille à l'autre, on effectue tout par select, on fait 10 fois la même opération inutile, etc.... Pour optimiser ta macro, il faudrait savoir ce que tu veux faire exactement : des instructions qui semblent "parasites" ne le sont peut-être pas Ensuite structurer ta macro : pour maintenir un code, surtout lorsque sa rédaction est loin dans le temps, le fait d'être structuré et commenté facilite la tâche de l'intervenant (même si le modificateur est le créateur) Enfin, proscrire les SELECT : sont peu utiles,t génèrent une perte de temps abominable et font clignoter les pages écran Pour la suppression des lignes : on les fait dans l'ordre inverses du numéros : plus facile de lire qu'on supprime la 6, puis la 3:4, que de comprendre supprimer 3:4, puis 4 dans ton code, tu supprimes inserres 2 ou 3 fois ton titre, en même temps que toutes les cellules filtrées ?!? Au lieu de supprimer Cells, supprime directement les lignes de 2 à dernière utilisée de la feuille : usedRange.(specielcells(xllastcell).row A+...

Gorfael · Answer

&#91;Re.... p'tite idée de ce que pourrait devenir la macro Sub Macro_DAILY_Incidents_1() On Error GoTo Err_Macro_DAILY_Incidents_1 'Déclaration ========================================================== Dim F_S As Worksheet Dim F_D As Worksheet Dim Err_Sect As Integer Dim Str_Titre As String 'MEI ================================================================== Application.ScreenUpdating = False 'blocage rafraîchissement écran pour accélérer le traitement Range("A7:A100").ClearContents 'feuille active : nom ? 'Sur la feuille en cours effacer les cellules A7:A100 'Source --------------------------------------------------------------- Sheets("company-details").Name = "by company-details" 'changement de nom Set F_S = Sheets("by company-details") 'Mise en variable feuille source F_S.Move Before:=Sheets(1) 'déplacer la feuille renommée en 1re position 'Destination ---------------------------------------------------------- Sheets.Add.Name = "group assigned-status" 'créer une feuille en 1re place dans le classeur Set F_D = Sheets("group assigned-status") 'l'assigner en variable 'Copie ================================================================ Err_Sect = 1 '+-+-+-+ With F_D F_S.Rows("1:5").Copy .Range("A1") .Rows("3:3").Delete 'copier lignes 1/2/4/5 source sur 1/2/3/4 destination .Rows(4).ClearContents 'effacer la ligne 4 .Move After:=Sheets(2) 'mettre la feuille "group assigned-status" en 2me position End With With F_S 'Mise en titre de la ligne 5 .Range("1:4, 6:6").Delete 'Supprimer les lignes 1 à 4 at 6 .Rows(1).CurrentRegion.AutoFilter Field:=35, _ Criteria1:="=*PROD*", Operator:=xlOr, Criteria2:="=*INTL*" 'filtrer "by company-details" avec comme critère : 'la cellule AI de la ligne contient soit "PROD" soit "INTL" .Range(Rows(2), Rows(UsedRange.SpecialCells(xlCellTypeLastCell).Row)).Delete 'supprimer la sélection .AutoFilter 'supprimer l'auto-filtre précédent .Rows(1).CurrentRegion.AutoFilter Field:=35, Criteria1:="=*Rolls*" .Range(Rows(2), Rows(UsedRange.SpecialCells(xlCellTypeLastCell).Row)).Delete 'supprimer la sélection .AutoFilter 'supprimer l'auto-filtre précédent End With '**************************************************************************** Err_Sect = 2 '+-+-+-+ Sheets(Array("by company-details", "group assigned-status")).Copy _ Before:=Workbooks("tdbJCD_DWRagOpen_aaaammjj.eds.xlt").Sheets(1) 'copier le contenu de "by company-details" dans la feuille active du modèle ?!? '**************************************************************************** '**************************************************************************** '**************** en l'état des infos, peux pas faire mieux ******************** '**************************************************************************** '**************************************************************************** Err_Sect = 3 '+-+-+-+ ActiveWorkbook.RefreshAll 'actualisation des TCD et liaisons externes '***************************************************************************************** ' Sauvegarde du fichier Err_Sect = 4 '+-+-+-+ ActiveWorkbook.SaveAs _ Filename:="\FRBMSBUR041	db$\Jcd\Client\Daily_Report	dbJCD_DWRagOpen " &amp; _ Format(Date, "yyyy") &amp; Format(Date, "mm") &amp; Format(Date, "dd") &amp; ".eds.xls", _ FileFormat:=xlNormal 'Sauvegarde du fichier ActiveWorkbook.Close ActiveWorkbook.Close 'fermer les 2 classeurs 'sortie obligatoire ===================================================== Sort_Macro_DAILY_Incidents_1: Application.ScreenUpdating = True Exit Sub 'Gestion des erreurs ==================================================== Err_Macro_DAILY_Incidents_1: Select Case Err_Sect Case 0 Str_Titre = "ERREUR DÉCLARATION ou MEI" Case 1 Str_Titre = "ERREUR COPIE DANS FEUILLE" Case 2 Str_Titre = "ERREUR COPIE DANS TABLEAU MODÈLE" Case 3 Str_Titre = "ERREUR RAFRAÎCHISSEMENT TCD" Case 4 Str_Titre = "ERREUR SAUVEGARDE DU FICHIER" End Select MsgBox Err.Number &amp; " " &amp; Err.Description, vbCritical + vbOKOnly, Str_Titre Resume Sort_Macro_DAILY_Incidents_1 End Sub Mais pas assez d'infos pour valider le code A+...