MACRO à rectifier ou à remplacer

Le 17/08/2016 à 13:55

Bonjour à vous, toutes et tous

Je reviens vers vous pour une aide.

Ci-joint un fichier que j'ai téléchargé en vue de le modifier et l'adapter sur mes besoins de gestion technique.

Malheureusement je me trouve bloquée au niveau de son MACRO, ce qui m'a fait faire recours à votre compétence en la matière.

Tous les détails explicatifs sont sur le fichier en pièce attaché.

Je vous remercie de me fournir votre aide.

Je débute avec VBA mais je suis encore trop loin d'être capable de résoudre mes blocages.

15suivi-ccrp.xlsm (49.05 Ko)
Le 17/08/2016 à 15:19

Hello NOURA,

Je sais pas si tu as vraiment besoin de vba ?? Une solution plus simple en formule, à voir si ça fait le job? Tu peux ajuster les plages source dans le gestionnaire de nom.

Cordialement

9suivi-ccrp-formules.xlsm (48.28 Ko)
Le 17/08/2016 à 15:29

Bonjour,

Pas pu déterminer pourquoi Find ne fonctionne pas... ! Pas d'erreur car à la ligne 45, cellule vide que Find trouve en B1, mais aucun renvoi...

De toute façon, si elle avait fonctionné, elle n'était pas adaptée à ton système de recherche, ne testant que la première cellule trouvée, il aurait fallu une adaptation pour la recherche du réseau, complétée par une adaptation pour la disposition de tes tableaux...

Je suggère une fonction personnalisée pour renvoyer l'index, sous réserve que n'ayant rien compris à ton mic-mac dans les formats, j'ai opté pour renvoyer la valeur affichée dans le journal sous forme de chaîne.

Function IDXJOUR(d As Date, réso As String) As String
    Dim dc As Object, c As Range, dd&
    Application.Volatile
    dd = CLng(d)
    Set dc = CreateObject("Scripting.Dictionary")
    With Worksheets("JOURNAL")
        For Each c In .Range("B8:B" & .Cells(.Rows.Count, 2).End(xlUp).Row)
            dc(c.Value2 & c.Offset(, 1).Value) = c.Offset(, 6).Text
        Next c
    End With
    IDXJOUR = dc(dd & réso)
End Function

Exemple : =IDXJOUR(C14;$D$9) ou =IDXJOUR(C57;$D$52)

Cordialement.

Le 17/08/2016 à 15:51
nonesofar13 a écrit :

Hello NOURA,

Je sais pas si tu as vraiment besoin de vba ?? Une solution plus simple en formule, à voir si ça fait le job? Tu peux ajuster les plages source dans le gestionnaire de nom.

Cordialement

Bonjour nonesofar13

Merci beaucoup du temps et de l’intérêt que tu as apportés à mon sujet.

Ce fichier n'est qu'une petite partie d'un fichier de grand volume qui traite des données de suivi de 4 ans.

Mon fichier est plein de formules matricielles ce qui le fait très lent et trop lourd.

Donc j'essaie l'améliorer petit à petit avec du VBA au lieu de formules.

Merci de ton aide et de ton aimable attention à mon sujet.

[quote="MFerrand"]Bonjour,

Pas pu déterminer pourquoi Find ne fonctionne pas... ! Pas d'erreur car à la ligne 45, cellule vide que Find trouve en B1, mais aucun renvoi...

De toute façon, si elle avait fonctionné, elle n'était pas adaptée à ton système de recherche, ne testant que la première cellule trouvée, il aurait fallu une adaptation pour la recherche du réseau, complétée par une adaptation pour la disposition de tes tableaux...

Je suggère une fonction personnalisée pour renvoyer l'index, sous réserve que n'ayant rien compris à ton mic-mac dans les formats, j'ai opté pour renvoyer la valeur affichée dans le journal sous forme de chaîne.

Bonjour MFerrand

Ravie de te croiser une autre fois. Je te remercie vivement.

Désolée, j'ai pas pu comprendre comment je dois utiliser cette fonction et la formule donnée.

puis-je te demander gentiment de l'adapter pratiquement sur le fichier.??

Le 17/08/2016 à 16:12

De rien Noura,

Ah c'est vrai que si tu as un fichier lourd c'est pas idéal !

La solution de MFerrand va te convenir je pense, c'est un mix de formule et vba .

Chez moi ça marche avec IDXJOUR

capture explication
Le 17/08/2016 à 16:19

Bonjour le fil, bonjour le forum,

Ooops 'ach'ment en r'tard sur ce coup là moi !... J'envoie quand même on ne sait jamais.

Je n'ai codé que deux boutons je te laisse le soin de terminer :

Option Explicit 'oblige à déclarer toutes les varaibles
Private OT As Worksheet 'déclare la variable OT (Onglet des Tableaux)
Private OJ As Worksheet 'déclare la variable OJ (Onglet Journal)
Private PR As Range 'déclare la variable PR (Plage des Relevés)
Private TD As Range 'déclare la variable TD (Tableau des Dates)
Private PAE As Range 'déclare la variable PAE (Plage À Efacer)
Private CR As Range 'déclare la variable CR (Cellule Réseau)
Private CD As Range 'déclare la variable CD (Cellule Date)

Sub MiseAJourFicheT1() 'bouton "Index du Mois" du tableau 1
Dim DL As Byte 'déclare la variable DL (Derniere Ligne)

Set OT = Worksheets("FMC") 'définit l'onglet OT
Set OJ = Worksheets("JOURNAL") 'définit l'onglet OJ
DL = OJ.Range("B" & Application.Rows.Count).End(xlUp).Row 'définit la dernière ligne éditée Dl de la colonne B de l'onglet OJ
Set PR = OJ.Range("B8:B" & DL) 'définit la plage PR des relevés de dates de l'onglet OJ

'partie à adapter
Set TD = OT.Range("C14:C44") 'définit le tableau des dates TD
Set PAE = OT.Range("J14:J44") 'définit la plage e effacer PAE
Set CR = OT.Range("D9").MergeArea(1) 'définit la cellule réseau CR
Set CD = Range("K7") 'définit la cellule date CD
Call Action 'appelle la procédure Action
End Sub

Sub MiseAJourFicheT2()
Dim DL As Byte

Set OT = Worksheets("FMC") 'définit l'onglet OT
Set OJ = Worksheets("JOURNAL") 'définit l'onglet OJ
DL = OJ.Range("B" & Application.Rows.Count).End(xlUp).Row 'définit la dernière ligne éditée Dl de la colonne B de l'onglet OJ
Set PR = OJ.Range("B8:B" & DL) 'définit la plage PR des relevés de dates de l'onglet OJ

'partie à adapter
Set TD = OT.Range("C61:C91")
Set PAE = OT.Range("J61:J91") 'définit la plage e effacer PAE
Set CR = OT.Range("D56").MergeArea(1) 'définit le tableau des dates TD
Set CD = Range("K54") 'définit la cellule date CD
Call Action 'appelle la procédure Action
End Sub

Public Sub Action()
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim R As Range 'déclare la variable R (Recherche)
Dim PA As String 'déclare la variable PA (Première Adresse)

If CR.Value <> "" And IsDate(CD.Value) Then 'condition 1 : si la cellule résaeu CR n'est pas vide et si la cellule date CD contient une date
    PAE.ClearContents 'efface le contenu de la plage a effacer PAE
    For Each CEL In TD 'boucle sur toutes les cellule CEL du tableau des dates TD
        Set R = PR.Find(CEL.Value, , xlFormulas, xlWhole) 'définit la recherche R (recherche la date contenue dans cel dans la plage des relevés PR)
        If Not R Is Nothing Then 'condition 2 : si il existe au moins une occurrence trouvée dans le plage PR
            PA = R.Address 'définit l'adresse PA de la première occurrence trouvée
            Do 'exécute
                If R.Offset(0, 1).Value = CR.Value Then 'condition 3: si la valeur de la cellule à droite de l'occurrence trouvée est égale à la valeur de la cellule réseau CR
                    CEL.Offset(0, 7).Value = R.Offset(0, 6).Value 'renvoie l'index équivalent dans la colonne J de l'onglet OT
                End If 'fin de la condition 3
                Set R = PR.FindNext(R) 'redéfinit la recherche R (occurrence suivante)
            Loop While Not R Is Nothing And R.Address <> PA 'boucle tant qu'il existe de nouvelles occurrences ailleurs qu'en PA
        End If 'fin de la condition 2
    Next CEL 'prochaine cellule de la boucle
End If 'fin de la condition 1
End Sub
Le 17/08/2016 à 16:25

Bon sang ! C'est vrai que c'était des formules... !

Merci ThauThème ! Ça me chagrinait un peu de ne pas trouver la source du problème...

Le 17/08/2016 à 16:39

Re,

@Mferrand

j'avoue que je n'ai toujours pas trouvé la différence entre xlValues et xlFormulas. Quand l'un ne fonctionne pas j'essaie l'autre... Et, bien sûr, j'avais commencé par xlValues...

Le 17/08/2016 à 16:42

Rebonjour à vous tous

Je vous remercie tous de l'aimable attention que vous avez apportée à mon sujet

Vous êtes vraiment des pro, gentils et serviables.

Un grand merci de ma part à

  • nonesofar13
  • MFerand
  • ThauTheme
  • et à tous les membres de ce magnifique forum

je vais essayer toutes les solutions proposées et je serais de retour

Cordialement

Rechercher des sujets similaires à "macro rectifier remplacer"