XL 2013 Macro VBA comparaison 2 feuilles

Olivier33390

XLDnaute Nouveau
Bonjour,
j'ai un fichier avec un tableau de bord dont la feuille est intitulée "Marché MT".
Les données des colonnes A à E sont renseignées d'après l'onglet "Extraction Pluri" avec la macro "Mise à jour TOT manquantes" et "Mise à jour tableau suivi".
Les données de la colonne E sont inscrites depuis l'onglet "Durée" via la macro.
Jusque là ça fonctionne, j'ai pu adapter une macro à ma sauce qui n'est certainement pas optimisée.
Pour la suite du tableau, je n'arrive pas à inscrire un 1 dans la colonne désirée (1R3721,2P3721,...) lorsque l'activité est présente sur ce code dans la colonne "Code projet EAM (M500) de la feuille "Extraction Pluri".
Plus compliqué, il faudrait aussi comparer et mettre un 1 dans les colonnes TEM sur le même principe mais en distinguant les années d'après la colonne "AT/TEM" et "Date échéance de l'EAM" de la feuille "Extraction Pluri".

J'ai volontairement tronqué le fichier car trop volumineux sinon.

J'arrive à la faire avec des recherches V mais c'est trop énergivore pour le CPU à recalculer à chaque fois.

Merci d'avance pour celles et ceux qui pourront m'aider.

Cdt.
 

Pièces jointes

  • Test Vision Pluri 2021_2028 forum Excel.xlsm
    353.2 KB · Affichages: 12

Olivier33390

XLDnaute Nouveau
Bonjour,

j'ai peut-être un début de code dans une macro indépendante des autres mais je n'arrive pas à dire d'écrire le "1" dans la colonne du code projet correspondant suite à comparaison de la colonne A de la feuille "Marché MT" et de la colonne D de la feuille "Extraction Pluri" :

Sub Import_dates()
'********************************
'* DECLARATIONS DES VARIABLES *
'********************************
Dim i%, j%, Dls%, Dld%, Sem%, Col%, projet%
Dim Ws As Worksheet, Wd As Worksheet
'********************************
'* INITIALISATION DES VARIABLES *
'********************************
Set Ws = Sheets("Extraction Pluri")
Set Wd = Sheets("Marché MT")
Dls = Ws.Range("A" & Rows.Count).End(xlUp).Row
Dld = Wd.Range("A" & Rows.Count).End(xlUp).Row
For j = 3 To Dld
For i = 3 To Dls
If Ws.Cells(i, 4).Value = Wd.Cells(j, 1).Value Then
projet = Ws.Cells(i, 6)
Wd.Cells(j, projet).Value = 1
End If
Next i
Next j
End Sub


Quelqu'un aurait-il une idée?

Merci d'avance.


Cdt
 

Olivier33390

XLDnaute Nouveau
Bonjour à tous,

j'avance sur le sujet et ci-après la macro en question qui fonctionne sauf le countifs qui remonte une erreur d'execution 1004 :

Sub Import_dates()

Dim ModeRecalcul As Long

Application.ScreenUpdating = False
ModeRecalcul = Application.Calculation
' Réglage du recalcul sur mode manuel
Application.Calculation = xlCalculationManual


'********************************
'* DECLARATIONS DES VARIABLES *
'********************************
Dim i%, j%, Dls%, Dld%, Sem%, Col%, projet%, année%
Dim Ws As Worksheet, Wd As Worksheet
'********************************
'* INITIALISATION DES VARIABLES *
'********************************
Set Ws = Sheets("Extraction Pluri")
Set Wd = Sheets("Marché MT")
Dls = Ws.Range("A" & Rows.Count).End(xlUp).Row
Dld = Wd.Range("A" & Rows.Count).End(xlUp).Row




For j = 3 To Dld
For i = 3 To Dls
If Ws.Cells(i, 12).Value = Wd.Cells(j, 1).Value And Ws.Cells(i, 7) = "1R3721" Then
Wd.Cells(j, 8).Value = 1
ElseIf Ws.Cells(i, 12).Value = Wd.Cells(j, 1).Value And Ws.Cells(i, 7) = "2P3721" Then
Wd.Cells(j, 9).Value = 1
ElseIf Ws.Cells(i, 12).Value = Wd.Cells(j, 1).Value And Ws.Cells(i, 7) = "3R3621" Then
Wd.Cells(j, 10).Value = 1
ElseIf Ws.Cells(i, 12).Value = Wd.Cells(j, 1).Value And Ws.Cells(i, 7) = "4P3721" Then
Wd.Cells(j, 11).Value = 1
End If

Wd.Cells(j, 12) = Wd.Cells(j, 8) + Wd.Cells(j, 9) + Wd.Cells(j, 10) + Wd.Cells(j, 11)
Wd.Cells(j, 13) = Wd.Cells(j, 12) * Wd.Cells(j, 6)
Wd.Cells(j, 7) = WorksheetFunction.CountIfs(Wd.Cells(j, 1), Ws.Cells(i, 12), Ws.Cells(i, 11), "TEM", DatePart("yyyy", Wd.Cells(i, 8)), "2021")
Next i
Next j




For j = 3 To Dld
For i = 3 To Dls
If Wd.Cells(j, 5) = "TEM" Then
Wd.Cells(j, 14) = Wd.Cells(j, 13) * "41,5"
ElseIf Wd.Cells(j, 5) = "AT" Then
Wd.Cells(j, 14) = Wd.Cells(j, 13) * "53,6"
End If
Next i
Next j





Application.ScreenUpdating = True

' Rétablissement du mode de recalcul d'origine
Application.Calculation = ModeRecalcul

End Sub

l'idée est de trouver le nombre d'occurrence d'un OTM dans la feuille Ws suivant 3 critères:
- "TEM"
- l'année
- l'OTM


Merci de votre aide.

Cdt
 

Discussions similaires

Réponses
5
Affichages
344