Filtre élaboré VBA

Bonsoir

Je suis intéressé par l'approche de filtre élaboré en vba et j'essaye de l'intégrer à mon projet en pièce jointe.

Le code pour managment semble être correct ou me donne les bonnes semaines. Comment l'écrire pour tenir compte des critères "Team" = Day ou Evening ou Night ou RVU.

Je veux juste les semaines qui ont rapport avec le critère choisi.

Exemple pour Day, je devrais avoir les semaines 2 et 52 seulement.

Dans le fichier joint, les semaines en jaune ne devraient pas apparaître. Le principe de valeur unique, pas de doublon.

Merci

bonjour lyttonjr,

voici une des macros

Sub sLoadFormulaeNight()
     Dim DernL, c, Sh
     Application.ScreenUpdating = False

     Set Sh = Sheets("Accepted")
     With Sh.Range("J2")                     'cellule "WK"
          ' Clear all formulae
          Union(.Offset(, 1).Resize(, 2), .Offset(1).Resize(20, 3)).ClearContents     ' 2 Years & 20 rows
          ' Load Years
          .Offset(, 1).Resize(, 2).Value = Application.Transpose(Sheets("Data").Range("A2:A3"))
          ' Load Weeks formula
          .Offset(1).Formula2 = "=IFERROR(SORT(UNIQUE(FILTER(sem,((cen=Data!G2)+(cen=Data!G3))*(team=Data!B4)))),""no data"")"
          ' Check if any data found/extracted
          DernL = Sh.Cells(Rows.Count, "J").End(xlUp).Row
          Set c = .Offset(1).Resize(DernL - .Row)
          If c.Cells(1).Value <> "no data" Then
               ' Load counters
               c.Offset(, 1).Resize(, 2).Formula2 = "=IFERROR(SUM(COUNTIFS(ann," & c.Cells(0, 2).Address(1, 0) & ",cen,Data!$G$2:$G$3,team," & Chr(34) & c.Cells(-1, 1).Value & Chr(34) & ",sem," & c.Cells(1).Address(0, 1) & ")),"""")"
          End If
          ' Convert Formulae to Values
          With c.Resize(, 3)
               .Value = .Value
          End With

     End With
     Application.ScreenUpdating = True

End Sub

re,

la macro "Boucle" est paramétrée, comme-ça avec une macro on sait faire tout.

Sub Boucle()
     Dim col
     With Sheets("Accepted")
          For col = 1 To 13 Step 3
               M_LoadFormulae .Cells(2, col)     'cellule "wk"
          Next
     End With
End Sub

Bonjour

Un code assez complexe pour moi. Quand je lance la macro boucle, les colonnes a,b,c sont vides alors que cela devrait être le total des autres colonnes.

Un grand merci!

re,

voici les choses adaptées pour "management" et un msgbox qui montre les formules.

Hello

Quand je rajoute plus de données dans le fichier, il ne semble pas fonctionner comme il faut. Au lieu d'afficher juste les semaines où il y a des données associées, je vois les 52 semaines pour chaque groupe.

J'ai attaché le fichier pour mieux illustrer la problématique.

Merci!

re,

j'ai ajouté les années dans la macro

Puis une version (peut-être trop compliquée pour le moment) dans le module "module1"

Bonjour

Le code très bien pour la partie semaine. Maintenant, je dois faire les parties mois et années.

Avec un code si complexe, je ne suis pas certain que je vais y arriver.

Hi Barth

Est-ce que je peux avoir les codes pour les sections mois et année dans le fichier?

Merci

oeps, oublié de télécharger le fichier

Bonjour

Un grand merci pour le code.

J'aurais besoin d'ajuster quelques points si possible.

. Si tu ne remplis pas les colonnes ID et que tu arrives à trier les mois sans, pourquoi ne pas les supprimer et ajuster les colonnes

. Pour la section année, il faut le remplir à partir de la feuille register. On doit avoir toutes les années disponibles avec les résultats correspondants par team.

Dans la partie du mois, le code s'arrête à cette ligne qui devient jaune : Application.DeleteCustomList Application.CustomListCount

Merci

re,

je ne comprends pas l'erreur de la ligne jaune, donc je l'ai supprimé, mais cela veut dire que j'ajoute chaque fois une liste supplémentaire à vos "Customlists".

Un moment donné, il faut les supprimer.

Bonsoir Barth

J'ai beau essayé d'adapter ton code à mes projets, je ne comprends pas tout le codage.

Dans le fichier joint, voici les principaux changements dont ton aide serait nécessaire!

- j'ai renommé RVU pour Inter

- J'ai rajouté un Team transport

- J'ai rajouté la feuille rapport qui contient les années en B7 et B8

Merci pour ton temps encore!

re,

Vous utilisez >=2021 (2021, 365, 2024) au lieu de 2019, je crois ? Donc un spécialiste des nouvelles formules peut vous donner une solution en formules.

Mais je prenais mes 2 années pour les macros de A2 et A3 de de la feuille "Data", si vous mettez là 2018 et 2019, vous aurez un résultat.

Bonsoir

Une approche par vba dont j'ai besoin d'aide. Le code me donne une erreur et je crois qu'il est mal écrit.

Possible d'écrire les critères correctement pour moi.

Merci

Sub SansDoublons_Week_Accepted()

Dim A(), d As New Dictionary, i As Long, an1 As Long, an2 As Long, Statut1$, Statut2$
A = Worksheets("Register").UsedRange.value

an1 = Worksheets("Data").Range("$A$2").value
an2 = Worksheets("Data").Range("$A$3").value
Statut1$ = Worksheets("Data").Range("$G$2").value
Statut2$ = Worksheets("Data").Range("$G$3").value

For i = 2 To UBound(A)
If (Year(A(i, 1)) = an1 And A(i, 12) = Statut1) Or (Year(A(i, 1)) = an2 And A(i, 12) = Statut1) _
Or (Year(A(i, 1)) = an1 And A(i, 12) = Statut2) Or (Year(A(i, 1)) = an2 And A(i, 12) = Statut2) _
Then
d(A(i, 14)) = A(i, 14)
End If
Next

If d.Count >= 1 Then
Worksheets("Accepted").Range("A3").Resize(d.Count) = Application.Transpose(d.Items)
Else
Worksheets("Accepted").Range("A3").value = 0 'd.Item(1)
End If

With Worksheets("Accepted").Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
.Sort Key1:=Worksheets("Accepted").Range("A2"), Order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes
End With

End Sub

an1 et an2 sont 0, cellules vides dans "Data", vos 2 années sont B7:B8 de "Report"

Hello

La demande est au niveau des critètes que j’essaye d’écrre en array.

Le fichier test a changé depuis pour les années.

Merci

le fichier du 27/4 avec votre macro de ce matin comme macro "paramétrée" et la macro "semaines" qui change les critères

EDIT : fichier modifié

Merci

re, je suppose que vous essayez la même chose pour les mois et si cela ne réussit pas ... .