Nettoyage macro

Bonjour, j'ai testé la macro et tout fonctionne mais j'ai un souci :

Je voudrais que lorsque l'acte est SYN,la durée (colonne N) de la synthèse soit multipliée par 2, que dois je modifier dans la macro?

Merci pour ton retour,

Cordialement,

Bonjour,

...
            If e = 0 Then
                .Cells(i, 13) = Left(.Cells(i, 9), 3)
                If u = 1 Then
                    .Cells(i, 10) = t: .Cells(i, 14) = t * 100 * .Cells(i, 15)
                    .Cells(i, 11) = UCase(Trim(Usa(0)))
                Else
                    t = Round(t / u, 2): .Cells(i, 10) = t: .Cells(i, 14) = t * 100 * .Cells(i, 15)
                    .Rows(i + 1 & ":" & i + u - 1).Insert
                    .Range("A" & i & ":S" & i).Copy .Range("A" & i + 1 & ":A" & i + u - 1)
                    For j = 1 To u
                        .Cells(i + j - 1, 11) = UCase(Trim(Usa(j - 1)))
                    Next j
                End If
            Else
                Enc = Split(.Cells(i, 7), ","): Tmp = Enc
                t = Round(t / (u * e), 2): .Cells(i, 10) = t: .Cells(i, 14) = t * 100 * .Cells(i, 15)
                If .Cells(i, 9) Like "[!G]*" Then
...

Cordialement.

Effectivement

merci beaucoup ...

J'ai appliqué la macro modifiée : la colonne N est bien doublée lorsqu'il y a une synthèse mais pas la colonne J, que dois je modifier ?

J'ai un peur de modifier la macro et de mal le faire !

Merci d'avance pour ton retour

Il faut être un peu précis dans tes demandes ! N c'est N, et J c'est J.

Si c'est N et J, on agit sur la source commune !

Donc éliminer les modifications précédentes et remplacer par :

            e = CInt(.Cells(i, 6)): t = Round(.Cells(i, 3) / 60, 2) * .Cells(i, 15)
            If e = 0 Then

Merci, je pensais faire ça également mais je voulais être sur lol

Oui désolé merci beaucoup

Bonjour,

Je reviens vers vous car j'aurais souhaiter ajouter quelque chose à la macro.

Une colonne supplémentaire en T nommé FACTURABLE.

Chaque cellule la composant irait faire une recherche V :

• valeur cherchée : chaque ligne de la colonne D (type d'activité)
• Table matrice : onglet REGLES ACTES colonne G (sixième colonne a partir de B)

Je vous joins le fichier, je pense après avoir lu votre macro, qu'il faut rajouter une fonction au début de la macro pour faire cette recherche, ensuite sur la partie mise en forme ajouter le nom FACTURABLE, mais comment appeler la fonction ligne par ligne ?

Pour éviter toutes bêtises, je préfère demander vos services !

Pouvez vous également m'expliquer la formule qu'il y a dans le gestionnaire de nom pour ActivEnc , car si elle est si complexe c'est surement pour une bonne raison !

Merci d'avance pour votre aide une fois de plus

Bonjour

Voila la modification de la première partie a toi de voir si ca te convient

voir le module2

A+

Maurice

Bonjour

Voila la première partie

Sub Activité()
Dim DernLigne As Long
Sheets(Feuil1.Name).Select
Application.ScreenUpdating = False
Range("I2:N" & Rows.Count).ClearContents
DernLigne = Range("A" & Rows.Count).End(xlUp).Row
   Range("I1").Value = "NB USAGERS"
   Range("J1").Value = "NB LIGNES"
   Range("K1").Value = "ACTIVITE TB"
   Range("L1").Value = "DUREE ACT."
   Range("M1").Value = "USAGERS A CONVERTIR"
   Range("N1").Value = "ENCADRANTS A CONVERTIR"
      Range("I2:I" & DernLigne).Formula = "=LEN(RC[-4])-LEN(SUBSTITUTE(RC[-4],"","",""""))"
      Range("J2:J" & DernLigne).Formula = "=IF(AND(VALUE(RC[-4])=0,RC[-1]>1),RC[-1],RC[-1]*RC[-4])"
      Range("K2:K" & DernLigne).Formula = "=IF(LEN(RC[-7])-LEN(SUBSTITUTE(RC[-7],""-"",))=1,LEFT(RC[-7],SEARCH(""-"",RC[-7],1)-1),RC[-7])"
      Range("L2:L" & DernLigne).Formula = "=IF(RC[-2]=0,ROUND(((RC[-10]-RC[-11])*24),2),ROUND(((RC[-10]-RC[-11])*24/RC[-2]),2))"
      Range("M2:M" & DernLigne).Formula = "=IF(RC[-8]="""",""0 ,"",IF(VALUE(RC[-7])=0,RC[-8],REPT(RC[-8],RC[-7])))"
      Range("N2:N" & DernLigne).Formula = "=IF(VALUE(RC[-8])=0,REPT(""0 ,"",RC[-5]),REPT(RC[-7],RC[-5]))"
'   Range("I2:N2").AutoFill Destination:=Range("I2:N" & DernLigne), Type:=xlFillDefault
      Range("I2:N" & DernLigne).Copy
      Range("I2").PasteSpecial xlPasteValues
   With Application
      .CutCopyMode = False
      .Goto [A1], True
   End With
End Sub

A+

Maurice

Bonsoir Massari,

Si je comprends bien, on ajoute une colonne à la fin dans laquelle on mettrait la mention Facturable ou Non facturable à rechercher sur mention en D dans la table... Rien si on ne trouve pas la mention ?

Une fonction comme pour la recherche dans Mapping peut se concevoir. Cela peut simplifier la modification de la procédure, il n'y aurait que l'ajout de colonne (avec en-tête, mise en forme...) et la récupération du résultat pour l'affecter.

Si c'est bien ça, je vois demain...

Cordialement.

Oui tu as tout comprit MFerrand, je précise juste que si la recherche ne donne rien j'aimerai avoir comme retour #NA,

Une fonction comme pour la recherche dans mapping serait nickel

Merci archer pour ton retour, mais MFerrand avait suivi la macro depuis le début !

Merci d'avance MFerrand pour ton retour,

Bon dimanche,

Cordialement,

Bonjour et bon dimanche j'espère !

Proposition :

Une variable niveau module :

Dim d As Object

Une fonction de recherche :

Function Facturable(act As String)
    Dim n%, i%
    If d Is Nothing Then
        Set d = CreateObject("Scripting.Dictionary")
        d.CompareMode = vbTextCompare
        With Worksheets("REGLES ACTES")
            n = .Cells(.Rows.Count, 2).End(xlUp).Row
            For i = 5 To n
                If .Cells(i, 2) <> "" Then
                    d(.Cells(i, 2).Value) = .Cells(i, 7).Value
                End If
            Next i
        End With
    End If
    If d.exists(act) Then
        Facturable = d(act)
    Else
        Facturable = CVErr(xlErrNA)
    End If
End Function

Objectif de la chose : la variable ne disparaît pas entre deux exécutions de la fonction. Lorsque la fonction sera exécutée une première fois elle teste la variable, si celle-ci n'est pas initialisée, elle le fait avec l'outil dictionary. Lors de ces exécutions suivantes, elle constatera que la variable est initialisée et n'aura qu'à piocher dedans.

Un dictionnaire est rapide à constituer, mais ce sera encore plus rapide s'il l'est déjà !

Une fois la procédure principale effectuée, inutile de conserver le dictionnaire en mémoire, on introduira donc un vidage à la fin de la procédure. Et si lors de développements ultérieurs tu avais à faire appel à cette fonction, aucun souci puisque si le dico n'est pas constitué, elle le constitue.

Pour la procédure principale, les modifications sont minimes :

Sub Activité()
    Dim Tmp, Usa, Enc, t, dln&, i&, j%, k%, e%, u%
    Application.ScreenUpdating = False
    With Worksheets("TB ACTIVITE")
        .Range("A1:J2").MergeCells = False
        .Rows(2).Delete
        Tmp = Split("ACTIVITE TB;DUREE ACT.;USAGERS;ENCADRANTS;ACTES;DUREE MORIO;NB ACTES;JOUR;" _
         & "N° MOIS;MOIS;ANNEE;FACTURABLE", ";")
        .Range("I1:T1").Value = Tmp
        dln = .Range("A" & .Rows.Count).End(xlUp).Row
        With .Range("I1:T" & dln)
            .HorizontalAlignment = xlCenter
            With .Borders
                .LineStyle = xlContinuous: Weight = xlThin
            End With
            With .Rows(1)
                .Interior.Color = RGB(128, 128, 128)
                With .Font
                    .Color = vbWhite: .Size = 16: .Bold = True
                End With
            End With
        End With
        For i = dln To 2 Step -1
            .Cells(i, 9) = Split(.Cells(i, 4), "-")(0)
            .Cells(i, 15) = IIf(.Cells(i, 4) = "SYN", 2, 1)
            .Cells(i, 16) = Day(.Cells(i, 1))
            .Cells(i, 17) = Month(.Cells(i, 1))
            .Cells(i, 18) = StrConv(MonthName(.Cells(i, 17)), vbProperCase)
            .Cells(i, 19) = Year(.Cells(i, 1))
           .Cells(i, 20) = Facturable(.Cells(i, 4))
            Usa = Split(.Cells(i, 5), ","): u = UBound(Usa)

    '[je passe sur le traitement lignes qui n'est pas affecté...]

        Next i
        .Columns("I:T").AutoFit
    End With
    If Not d Is Nothing Then d.RemoveAll: Set d = Nothing
End Sub

Je n'ai pas testé sauf la fonction, et j'espère n'avoir rien loupé...

Cordialement.

Bonjour et bon dimanche également,

J'ai testé, le hic c'est qu'il doit me remplir chaque ligne insérée lors de cette recherche, et avec la modif faite il le fait uniquement sur les lignes non insérées,

"Un dictionnaire est rapide à constituer, mais ce sera encore plus rapide s'il l'est déjà ! " : dois je le constituer???

Merci pour votre retour,

Cordialement,

Arh ! J'ai sans doute oublié d'étendre la recopie à la colonne T !

Je regarde.

c pas grave tkt , merci pour tout

Ça a bien l'air d'être ça !

            If e = 0 Then
                .Cells(i, 13) = Left(.Cells(i, 9), 3)
                If u = 1 Then
                    .Cells(i, 10) = t: .Cells(i, 14) = t * 100
                    .Cells(i, 11) = UCase(Trim(Usa(0)))
                Else
                    t = Round(t / u, 2): .Cells(i, 10) = t: .Cells(i, 14) = t * 100
                    .Rows(i + 1 & ":" & i + u - 1).Insert
                    .Range("A" & i & ":T" & i).Copy .Range("A" & i + 1 & ":A" & i + u - 1)
                    For j = 1 To u
                        .Cells(i + j - 1, 11) = UCase(Trim(Usa(j - 1)))
                    Next j
                End If
            Else
                Enc = Split(.Cells(i, 7), ","): Tmp = Enc
                t = Round(t / (u * e), 2): .Cells(i, 10) = t: .Cells(i, 14) = t * 100
                If .Cells(i, 9) Like "[!G]*" Then
                    .Cells(i, 13) = Left(.Cells(i, 9), 3)
                    Tmp(0) = ""
                Else
                    For j = 1 To e
                        Tmp(j - 1) = ActEnc(Enc(j - 1))
                    Next j
                End If
                If u * e > 1 Then
                    .Rows(i + 1 & ":" & i + u * e - 1).Insert
                    .Range("A" & i & ":T" & i).Copy .Range("A" & i + 1 & ":A" & i + u * e - 1)
                End If
                For j = 1 To u
                    For k = 1 To e
                        .Cells(i + (j - 1) * e + k - 1, 11) = UCase(Trim(Usa(j - 1)))
                        .Cells(i + (j - 1) * e + k - 1, 12) = Trim(Enc(k - 1))
                        If Tmp(0) <> "" Then .Cells(i + (j - 1) * e + k - 1, 13) = Tmp(k - 1)
                    Next k
                Next j
            End If

C parfait une fois de plus,

Je vais tester avec les différentes extractions mais cela devrait fonctionner

Merci pour tout, c'est vraiment appréciable d'voir trouver quelqu'un comme vous sur le forum pour rendre ces services qui ne sont pas à la portée de tous

Bon dimanche MFerrand

Bonjour MFerrand,

Je reviens vers vous pour le fichier mis en place, j'ai un souci sur le nom surligné en rouge dans le fichier joint.

Il est bien indiqué le mapping mais il ne me met pas le code acte associé.

Pouvez vous une nouvelle m'aider sur ce point,

Merci d'avance,

Cordialement,

Bonjour,

Je pense que c'est dû au fait que dans mapping le prénom de l'intéressé est en minuscules. Les encadrants doivent être en majuscules dans Mapping, une conversion automatique en majuscule et en supprimant les espaces parasites est faite pour la recherche...

Mets COUTO MARIE-BLANCHE dans Mapping, et vois ce que cela donne...

Tu pourrais avoir un autre cas de distorsion pour des noms qui pourraient figurer dans le tableau avec des minuscules accentuées, par exemple : PINOL Céline, qui serait convertie en PINOL CÉLINE, non trouvé car différent de PINOL CELINE

ou la présence de trait d'union ou non dans les prénoms composés :

ALFANO Anne-Sophie dans le tableau serait convertie en ALFANO ANNE-SOPHIE, non trouvée car différent de ALFANO ANNE SOPHIE !

Si le cas survenait, la modification la plus simple consisterait à lister toutes les variantes majuscules possibles dans la liste Mapping.

Exemple :

MOREL MARIE HELENE

MOREL MARIE-HELENE

MOREL MARIE HÉLENE

MOREL MARIE HELÈNE

MOREL MARIE HÉLÈNE

MOREL MARIE-HÉLENE

MOREL MARIE-HELÈNE

MOREL MARIE-HÉLÈNE

Là, c'est déjà un cas maximal, certains resteraient en un exemplaire, comme BUSIN INGRID, et la plupart donneraient lieu à des variantes beaucoup moins nombreuses.

Cordialement.

Bonjour,

Merci pour votre retour, la modification en majuscule fonctionne.

Comprenant la cause du problème je modifierai selon les besoins la liste des encadrants !

Merci une fois de plus

Bonne fin d’après-midi !