Comptage avec une macro automatique

Bonjour à tous, j'espère que vous allez bien, je souhaite demander votre aide svp,

Je souhaite compter avec une macro qui s'éxecute en automatique si modification dans l'onglet "TRVX EN COURS":

le nombre de "T" de la colonne D pour chaque mois qui se trouvent dans la colonne Q, puis a remettre dans l'onglet "STATISTIQUES" dans le cas du mois correspondant, case TERMINES

le nombre de "A" de la colonne C pour chaque mois qui se trouvent dans la colonne Q, puis a remettre dans l'onglet "STATISTIQUES 2" dans le cas du mois correspondant ,case ARRET DE PRODUCTION

le nombre de "G" de la colonne C pour chaque mois qui se trouvent dans la colonne Q, puis a remettre dans l'onglet "STATISTIQUES 2" dans le cas du mois correspondant ,case GENE A LA PRODUCTION

le nombre de "N" de la colonne C pour chaque mois qui se trouvent dans la colonne Q, puis a remettre dans l'onglet "STATISTIQUES 2" dans le cas du mois correspondant,case SANS INCIDENCE

Je vous laisse mon fichier en pièce jointe.

Merci d'avance.

Bonjour Imad SIO, le forum,

le nombre de "T" de la colonne D pour chaque mois qui se trouvent dans la colonne Q, puis a remettre dans l'onglet "STATISTIQUES" dans le cas du mois correspondant, case TERMINES

A tester....avec une formule...

En C18 de la feuille STATISTIQUES:

=SOMMEPROD(('TRVX EN COURS'!$D$2:$D$16="T")*(MOIS('TRVX EN COURS'!$Q$2:$Q$16)=MOIS(STATISTIQUES!C16)*(ANNEE('TRVX EN COURS'!$Q$2:$Q$16)=ANNEE(STATISTIQUES!C16))))

Cordialement,

Bonjour Xorsankukai,

je le veux avec une macro pour ne pas alourdir mon fichier, il est assèz lourd avec les formules

Re,

Un essai....

Code à placer dans le module de la feuille 'STATISTIQUES'

Private Sub Worksheet_Activate()
 Dim lig%, col%, i%, cpt%, tb
  Application.ScreenUpdating = False

   With Sheets("TRVX EN COURS")
    tb = .Range("A2:AB" & .Range("A" & Rows.Count).End(xlUp).Row)
   End With

   With Sheets("STATISTIQUES")
    For lig = 18 To 37 Step 8
     For col = 3 To 18 Step 4
       For i = 1 To UBound(tb, 1)
        If tb(i, 4) = "T" And Month(CDate(tb(i, 17))) = Month(.Cells(lig, col).Offset(-2, 0).MergeArea.Cells(1, 1)) _
         And Year(CDate(tb(i, 17))) = Year(.Cells(lig, col).Offset(-2, 0).MergeArea.Cells(1, 1)) Then cpt = cpt + 1
       Next i
       .Cells(lig, col) = cpt: cpt = 0
     Next col
    Next lig
   End With
End Sub

La macro s'exécute à l'activation de la feuille....

Cordialement,

Re,

Merci pour le retour,

Puisque c'est OK, essayons avec 'STATISTIQUES 2'....

Private Sub Worksheet_Activate()
 Dim lig%, col%, i%, cptA%, cptB%, cptC%, tb
  Application.ScreenUpdating = False
  'Application.Calculation = xlCalculationManual

   With Sheets("TRVX EN COURS")
    tb = .Range("A2:AB" & .Range("A" & Rows.Count).End(xlUp).Row)
   End With

   With Sheets("STATISTIQUES 2")
    For lig = 9 To 30 Step 9
     For col = 3 To 18 Step 4
       For i = 1 To UBound(tb, 1)
        If tb(i, 3) = "A" And Month(CDate(tb(i, 17))) = Month(.Cells(lig, col).Offset(-2, 0).MergeArea.Cells(1, 1)) _
         And Year(CDate(tb(i, 17))) = Year(.Cells(lig, col).Offset(-2, 0).MergeArea.Cells(1, 1)) Then cptA = cptA + 1
        If tb(i, 3) = "G" And Month(CDate(tb(i, 17))) = Month(.Cells(lig + 1, col).Offset(-3, 0).MergeArea.Cells(1, 1)) _
         And Year(CDate(tb(i, 17))) = Year(.Cells(lig + 1, col).Offset(-3, 0).MergeArea.Cells(1, 1)) Then cptB = cptB + 1
        If tb(i, 3) = "N" And Month(CDate(tb(i, 17))) = Month(.Cells(lig + 3, col).Offset(-5, 0).MergeArea.Cells(1, 1)) _
         And Year(CDate(tb(i, 17))) = Year(.Cells(lig + 3, col).Offset(-5, 0).MergeArea.Cells(1, 1)) Then cptC = cptC + 1
       Next i
       .Cells(lig, col) = cptA: cptA = 0
       .Cells(lig + 1, col) = cptB: cptB = 0
       .Cells(lig + 3, col) = cptC: cptC = 0
     Next col
    Next lig
   End With
  'Application.Calculation = xlCalculationAutomatic
End Sub

Code à placer dans le module de la feuille 'STATISTIQUES 2', La macro s'exécute à l'activation de la feuille....

Cordialement

ça fonctionne mais il y a un problème

je veux qu'il calcule que pour le mois en cours, pour ne pas ecraser les valeurs des autres mois,

par exemple, on est en janvier, il calcule pour janvier

si on est en fevrier, il calcule pour fevrier, MAIS JE VEUX PAS QU'IL ECRASE LA VALEUR DE JANVIER

est ce que c'est possible de faire ça

Re,

Nouvelle tentative, n'agit que sur le mois en cours (enfin, j'espère )...

Il est certainement possible de simplifier le code.........

Cordialement,

Bonjour xorsankukai,

ça fonctionne super bien, mais quand je copie le code dans mon vrai fichier, ça bug sur cette ligne :

alors que le fichier à la même structure que celui que j'ai envoyé

Bonjour et merci pour le retour,

ça fonctionne super bien, mais quand je copie le code dans mon vrai fichier, ça bug sur cette ligne :

alors que le fichier à la même structure que celui que j'ai envoyé

Si ma macro fonctionne bien sur mon fichier test et pas sur le tien, il doit forcément y avoir une différence....

On parle bien de la macro de la feuille STATISTIQUES

Sur la feuille TVRX EN COURS :

• Les données (sans les titres) s'étendent bien de A2 à AB et dernière ligne (définie en fonction de la colonne A) ?
• La 4ème colonne de données correspond bien à la colonne où il faut chercher les T ?
• La 17ème colonne de données correspond bien à la colonne où il faut chercher les dates ?

Sur la feuille STATISTIQUES :

• Pour Janvier 2022 : date à comparer (lemois) est bien en C16:F16 ? ; Février 2022 en G16:J16 ? ; Mars 2022 en K16:N16 et Avril 2022 en O16:R16 ?
• Idem pour MAI 2022; JUIN 2022, JUILLET 2022 et Août 2022 en ligne 24 ?
• Idem pour Septembre 2022, Octobre 2022, Novembre 2022 et Décembre 2022 en ligne 32 ?

Le CDATE n'est peut-être pas utile ?

If tb(i, 4) = "T" And Month(tb(i, 17)) = Month(lemois) And Year(tb(i, 17)) = Year(lemois) Then cpt = cpt + 1

Cordialement,

bonjour,

toujours le même problème,

est-t il possible de la faire avec la fonction countifs ?

Bonjour Imad SIO,

Un essai avec Countifs....

Cordialement,

Bonjour xorsankukai,

ça tourne à merveille, même en la copiant sur mon fichier d'origine.

je te remercie du fond du cœur pour le temps que t'as consacré pour moi;

passe une excellente journée !

Re,

Ravi que ton problème soit solutionné,

A bientôt,

Je souhaite filtrer la colonne "F" du fichier "TRAVAUX" sur les interventions qui commencent par "DIT N°xxxx" et les envoyer dans le fichier "historique", mais en gardant le même classement initial dans le fichier historique . C'est comme une mise à jour, sauf que je veux copier :

- la colonne "D" et la coller dans la colonne "D" dans historique qui correspond

- la colonne "L" et la coller dans la colonne "L" dans historique qui correspond

- la colonne "Q" " et la coller dans la colonne "V" dans historique qui correspond

- la colonne "A" " et la coller dans la colonne "U" dans historique qui correspond

je vous laisse mes 2 fichiers .

est ce que c'est possible ?

Merci d'avance

Bonjour Imad SIO, le forum,

Pas sur de bien comprendre....

Sur la feuille "Historique de demandes", tu souhaites compléter les lignes déjà inscrites ?

Donc pour les 3 lignes dans ton exemple, il faut aller rechercher les infos "ETAT", "DATE PREVUE", "DATE FIN TRAVAUX" et "N° PERMIS" sur la feuille "TRVX EN COURS" ?

[EDIT] Je vois que tu as ouvert un autre post...https://forum.excel-pratique.com/excel/mise-a-jour-par-un-copier-coller-entre-deux-classeurs-167792

Cordialement,

Salut 😃😃,

Oui c’est tout à fait ça, c’est comme une mise à jour des informations, mise à jours des lignes de la colonne F.

Mais je souhaite que le bouton soit dans le fichier travaux et non dans le fichier historique.

Si c’est possible bien sûr

Merci d’avance

Re,

Un essai avec Index/Equiv....

• Attention, les 2 fichiers doivent être ouverts
• J'ai supprimé la validation de données en colonne E (feuille Historique de demandes).

Sub MAJ()
 Dim dl%, derlig%, lig%
 Dim valeurcherchée, wf As Worksheet
 Dim etat As Range, dateprévue As Range, dateFT As Range, permis As Range, DI As Range
 Dim V1, V2, V3, V4

    If Not FichOuvert("historique.xlsx") Then
        MsgBox "Le fichier de destination" & Chr(10) & "historique.xlsx" & Chr(10) & "n'est pas ouvert.": Exit Sub
    End If

              Set wf = Workbooks("travaux.xlsm").Sheets("TRVX EN COURS")
            derlig = wf.Range("A" & Rows.Count).End(xlUp).Row
          Set etat = wf.Range("D2:D" & derlig)
    Set dateprévue = wf.Range("L2:L" & derlig)
        Set dateFT = wf.Range("Q2:Q" & derlig)
        Set permis = wf.Range("A2:A" & derlig)
            Set DI = wf.Range("F2:F" & derlig)

  With Workbooks("historique.xlsx").Sheets("Historique de demandes")
   dl = .Range("A" & Rows.Count).End(xlUp).Row
    If dl < 7 Then Exit Sub
     lig = 7
     Do While lig <= dl
       valeurcherchée = .Range("A" & lig) & "*"
        V1 = IIf(IsError(WorksheetFunction.Index(etat, WorksheetFunction.Match(valeurcherchée, DI, 0))), "", WorksheetFunction.Index(etat, WorksheetFunction.Match(valeurcherchée, DI, 0)))
        .Range("D" & lig) = V1
        V2 = IIf(IsError(WorksheetFunction.Index(dateprévue, WorksheetFunction.Match(valeurcherchée, DI, 0))), "", WorksheetFunction.Index(dateprévue, WorksheetFunction.Match(valeurcherchée, DI, 0)))
        .Range("L" & lig) = V2
        V3 = IIf(IsError(WorksheetFunction.Index(dateFT, WorksheetFunction.Match(valeurcherchée, DI, 0))), "", WorksheetFunction.Index(dateFT, WorksheetFunction.Match(valeurcherchée, DI, 0)))
        .Range("V" & lig) = V3
        V4 = IIf(IsError(WorksheetFunction.Index(permis, WorksheetFunction.Match(valeurcherchée, DI, 0))), "", WorksheetFunction.Index(permis, WorksheetFunction.Match(valeurcherchée, DI, 0)))
        .Range("U" & lig) = V4
     lig = lig + 1
     Loop
  End With
  MsgBox "Mise à jour effectuée"
End Sub

Function FichOuvert(F As String) As Boolean
'myDearFriend!  -  www.mdf-xlpages.com
    On Error Resume Next
    FichOuvert = Not Workbooks(F) Is Nothing
End Function

La macro se nomme MAJ (module dans classeur travaux).

Cordialement,

Bonjour et merci pour ce retour,

y a t-il une ligne dans la macro qui s'exécute en continu ? à chaque modification ?

Non, aucun évènement lié à la macro....

J'ai rajouté quelques lignes afin de libérer de la mémoire, à voir si amélioration....

Sub MAJ()
 Dim dl%, derlig%, lig%
 Dim valeurcherchée, wf As Worksheet
 Dim etat As Range, dateprévue As Range, dateFT As Range, permis As Range, DI As Range
 Dim V1, V2, V3, V4

    If Not FichOuvert("historique.xlsx") Then
        MsgBox "Le fichier de destination" & Chr(10) & "historique.xlsx" & Chr(10) & "n'est pas ouvert.": Exit Sub
    End If

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

              Set wf = Workbooks("travaux.xlsm").Sheets("TRVX EN COURS")
            derlig = wf.Range("A" & Rows.Count).End(xlUp).Row
          Set etat = wf.Range("D2:D" & derlig)
    Set dateprévue = wf.Range("L2:L" & derlig)
        Set dateFT = wf.Range("Q2:Q" & derlig)
        Set permis = wf.Range("A2:A" & derlig)
            Set DI = wf.Range("F2:F" & derlig)

  With Workbooks("historique.xlsx").Sheets("Historique de demandes")
   dl = .Range("A" & Rows.Count).End(xlUp).Row
    If dl < 7 Then Exit Sub
     lig = 7
     Do While lig <= dl
       valeurcherchée = .Range("A" & lig) & "*"
        V1 = IIf(IsError(WorksheetFunction.Index(etat, WorksheetFunction.Match(valeurcherchée, DI, 0))), "", WorksheetFunction.Index(etat, WorksheetFunction.Match(valeurcherchée, DI, 0)))
        .Range("D" & lig) = V1
        V2 = IIf(IsError(WorksheetFunction.Index(dateprévue, WorksheetFunction.Match(valeurcherchée, DI, 0))), "", WorksheetFunction.Index(dateprévue, WorksheetFunction.Match(valeurcherchée, DI, 0)))
        .Range("L" & lig) = V2
        V3 = IIf(IsError(WorksheetFunction.Index(dateFT, WorksheetFunction.Match(valeurcherchée, DI, 0))), "", WorksheetFunction.Index(dateFT, WorksheetFunction.Match(valeurcherchée, DI, 0)))
        .Range("V" & lig) = V3
        V4 = IIf(IsError(WorksheetFunction.Index(permis, WorksheetFunction.Match(valeurcherchée, DI, 0))), "", WorksheetFunction.Index(permis, WorksheetFunction.Match(valeurcherchée, DI, 0)))
        .Range("U" & lig) = V4
     lig = lig + 1
     Loop
  End With
  MsgBox "Mise à jour effectuée"
  Application.Calculation = xlCalculationAutomatic
  Set etat = Nothing: Set dateprévue = Nothing: Set datFT = Nothing: Set permis = Nothing
  Set DI = Nothing: Set valeurcherchée = Nothing
End Sub

Function FichOuvert(F As String) As Boolean
'myDearFriend!  -  www.mdf-xlpages.com
    On Error Resume Next
    FichOuvert = Not Workbooks(F) Is Nothing
End Function

[EDIT]: tu as une formule en colonne A de ta feuille "Historique de demandes" qui s'étant jusqu'à la ligne 5062.

Or, comme je définie la dernière ligne en fonction de la colonne A, celle-ci est donc faussée, la boucle s'effectue alors de la ligne 7 à 5062 (au lieu de 9 dans ton exemple).

On peut essayer de la définir à partir de la colonne F si celle-ci est toujours remplie ?

With Workbooks("historique.xlsx").Sheets("Historique de demandes")
   dl = .Range("F" & Rows.Count).End(xlUp).Row

Sinon, il faudra passer par un tablo....

Cordialement,