Conditions qui s'exécute mal

Le 17/05/2016 à 11:17

Bonjour,

Je me suis lancée dans une boucles if, then, else.

Mais là, impossible de la faire marcher correctement !

J'ai dans ma macro, 3 "sous-macro", le but :

si la première condition est fausse voir la deuxième
si la deuxième est fausse voir la troisième
si les deux premières sont fausses la troisième sera forcément vraie.

Mon problème est que la macro, me ressort toujours un TCD (but de la macro) sur la même condition même si celle-ci est fausse !

Comment cela se fait-il ? Et comment puis-je y remédier ?

Merci à ceux qui auront prit le temps de lire, et à ceux qui me répondront.

Option Explicit
Sub TEST_TRI()
'
' TEST_TRI Macro
' Macro enregistrée le 10/05/2016 par lycée

'Suppression TCD
  Sheets("Tableau").Activate
  Range("A1:Q300").Select
  Range("Q300").Activate
  Selection.Delete

  'Suppresion Liste
  Sheets("Liste").Activate
  Range("A1:L400").Select
  Range("L400").Activate
  Selection.Delete

    'Définition des critères pour CITEC
Sheets("Génération").Activate
If [B1] = 1 Or 2 And [C1] = 3 And [D1] = 1 Or 2 And [E1] = 1 Or 2 And [K1] = 1 Or 2 And [L1] = 1 Or 2 Then

    'Filtre élaboré pour trier la BD élève
    Sheets("BD Eleves").Range("A1:L400").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Génération").Range("T4:AE5"), CopyToRange:=Sheets("Liste").Range( _
        "A1:L1"), Unique:=False

    Sheets("Liste").Select
    'Tri de la feuille Liste, par Option 4 puis 5
    Cells.Select
    Selection.Sort Key1:=Range("I2"), Order1:=xlAscending, Key2:=Range("H2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal

    'Déclaration des variables
    Range("A1").Select

 Dim wb As Workbook
Dim ws As Worksheet, ws2 As Worksheet
Dim PTCache As PivotCache
Dim pt As PivotTable
Dim rngPT As Range

    'Optimisation (Gel Affichage)
    Application.ScreenUpdating = False

    'Initialisation des variables
    Set wb = ActiveWorkbook
    Set ws = wb.Worksheets("Liste")
    Set rngPT = ws.Cells(1).CurrentRegion     'Données sources du TCD
    Set ws2 = wb.Worksheets("Tableau")
    'Suppression TCD
    On Error Resume Next
    ws2.PivotTables(1).TableRange2.Clear
    On Error GoTo 0

   'Création du cache de TCD (à partir de rngPT)
    Set PTCache = wb.PivotCaches.Add _
                  (SourceType:=xlDatabase, _
                   SourceData:=rngPT)

    'Création du TCD en feuille 'Tableau' nommé TCD_1
    Set pt = PTCache.CreatePivotTable _
             (tabledestination:=ws2.Cells(6, 2), _
              TableName:="TCD_1", _
              defaultversion:=xlPivotTableVersion10)
    With pt

    'Calcul TCD manuel (Optimisation)
        .ManualUpdate = True

    'Ajout des étiquettes de lignes et colonnes
        .AddFields RowFields:=Array("OPTION 4", "OPTION ECO"), _
                   ColumnFields:="SEXE"

     'Ajout champ valeurs
        With .PivotFields("NOM")
            .Orientation = xlDataField
            .Function = xlCount
            .NumberFormat = "#,##0"
            .Caption = "NB NOMS"
        End With

      'Calcul automatique (affiche le TCD)
        .ManualUpdate = False
    End With

    wb.ShowPivotTableFieldList = False

    With ws2
        .Activate
        .[A1].Select
    End With

    Set rngPT = Nothing
    Set pt = Nothing
    Set PTCache = Nothing
    Set ws2 = Nothing: Set ws = Nothing
    Set wb = Nothing

Sheets("Tableau").Activate
    'Définition des critères pour SC-IG

Sheets("Génération").Activate
ElseIf [B1] = 1 Or 2 And [C1] = 9 And [D1] = 1 Or 2 And [E1] = 1 Or 2 And [K1] = 1 Or 2 And [L1] = 1 Or 2 Then

'Suppression TCD
  Sheets("Tableau").Activate
  Range("A1:Q300").Select
  Range("Q300").Activate
  Selection.Delete

  'Suppresion Liste
  Sheets("Liste").Activate
  Range("A1:L400").Select
  Range("L400").Activate
  Selection.Delete

    'Filtre élaboré pour trier la BD élève
    Sheets("BD Eleves").Range("A1:L400").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Génération").Range("T7:AE8"), CopyToRange:=Sheets("Liste").Range( _
        "A1:L1"), Unique:=False

    Sheets("Liste").Select
    'Tri de la feuille Liste, par Option 4 puis 5
    Cells.Select
    Selection.Sort Key1:=Range("I2"), Order1:=xlAscending, Key2:=Range("H2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal

    'Déclaration des variables
    Range("A1").Select

 Dim wb1 As Workbook
Dim ws3 As Worksheet, ws4 As Worksheet
Dim PTCache1 As PivotCache
Dim pt1 As PivotTable
Dim rngPT1 As Range

    'Optimisation (Gel Affichage)
    Application.ScreenUpdating = False

    'Initialisation des variables
    Set wb1 = ActiveWorkbook
    Set ws3 = wb1.Worksheets("Liste")
    Set rngPT1 = ws3.Cells(1).CurrentRegion     'Données sources du TCD
    Set ws4 = wb1.Worksheets("Tableau")
    'Suppression TCD
    On Error Resume Next
    ws4.PivotTables(1).TableRange2.Clear
    On Error GoTo 0

   'Création du cache de TCD (à partir de rngPT)
    Set PTCache1 = wb1.PivotCaches.Add _
                  (SourceType:=xlDatabase, _
                   SourceData:=rngPT1)

    'Création du TCD en feuille 'Tableau' nommé TCD_1
    Set pt1 = PTCache1.CreatePivotTable _
             (tabledestination:=ws4.Cells(6, 2), _
              TableName:="TCD_1", _
              defaultversion:=xlPivotTableVersion10)
    With pt1

    'Calcul TCD manuel (Optimisation)
        .ManualUpdate = True

    'Ajout des étiquettes de lignes et colonnes
        .AddFields RowFields:=Array("OPTION 4", "OPTION ECO"), _
                   ColumnFields:="SEXE"

     'Ajout champ valeurs
        With .PivotFields("NOM")
            .Orientation = xlDataField
            .Function = xlCount
            .NumberFormat = "#,##0"
            .Caption = "NB NOMS"
        End With

      'Calcul automatique (affiche le TCD)
        .ManualUpdate = False
    End With

    wb1.ShowPivotTableFieldList = False

    With ws4
        .Activate
        .[A1].Select
    End With

    Set rngPT1 = Nothing
    Set pt1 = Nothing
    Set PTCache1 = Nothing
    Set ws4 = Nothing: Set ws3 = Nothing
    Set wb1 = Nothing

    Sheets("Tableau").Activate

    'Définition des critères pour SES
Sheets("Génération").Activate
Else: [B1] = 4 And [C1] = 1 Or 2 And [D1] = 1 Or 2 And [E1] = 1 Or 2 And [K1] = 1 Or 2 And [L1] = 1 Or 2

'Suppression TCD
  Sheets("Tableau").Activate
  Range("A1:Q300").Select
  Range("Q300").Activate
  Selection.Delete

  'Suppresion Liste
  Sheets("Liste").Activate
  Range("A1:L400").Select
  Range("L400").Activate
  Selection.Delete

    'Filtre élaboré pour trier la BD élève
    Sheets("BD Eleves").Range("A1:L400").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Génération").Range("T17:AE18"), CopyToRange:=Sheets("Liste").Range( _
        "A1:L1"), Unique:=False

    Sheets("Liste").Select
    'Tri de la feuille Liste, par Option 4 puis 5
    Cells.Select
    Selection.Sort Key1:=Range("H2"), Order1:=xlAscending, Key2:=Range("I2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal

    'Déclaration des variables
    Range("A1").Select

 Dim wb2 As Workbook
Dim ws5 As Worksheet, ws6 As Worksheet
Dim PTCache2 As PivotCache
Dim pt2 As PivotTable
Dim rngPT2 As Range

    'Optimisation (Gel Affichage)
    Application.ScreenUpdating = False

    'Initialisation des variables
    Set wb2 = ActiveWorkbook
    Set ws5 = wb2.Worksheets("Liste")
    Set rngPT2 = ws5.Cells(1).CurrentRegion     'Données sources du TCD
    Set ws6 = wb2.Worksheets("Tableau")
    'Suppression TCD
    On Error Resume Next
    ws6.PivotTables(1).TableRange2.Clear
    On Error GoTo 0

   'Création du cache de TCD (à partir de rngPT)
    Set PTCache2 = wb2.PivotCaches.Add _
                  (SourceType:=xlDatabase, _
                   SourceData:=rngPT1)

    'Création du TCD en feuille 'Tableau' nommé TCD_1
    Set pt2 = PTCache2.CreatePivotTable _
             (tabledestination:=ws6.Cells(6, 2), _
              TableName:="TCD_1", _
              defaultversion:=xlPivotTableVersion10)
    With pt2

    'Calcul TCD manuel (Optimisation)
        .ManualUpdate = True

    'Ajout des étiquettes de lignes et colonnes
        .AddFields RowFields:="OPTION ECO", _
                   ColumnFields:=Array("OPTION 4", "SEXE")

     'Ajout champ valeurs
        With .PivotFields("NOM")
            .Orientation = xlDataField
            .Function = xlCount
            .NumberFormat = "#,##0"
            .Caption = "NB NOMS"
        End With

      'Calcul automatique (affiche le TCD)
        .ManualUpdate = False
    End With

    wb2.ShowPivotTableFieldList = False

    With ws6
        .Activate
        .[A1].Select
    End With

    Set rngPT2 = Nothing
    Set pt2 = Nothing
    Set PTCache2 = Nothing
    Set ws6 = Nothing: Set ws5 = Nothing
    Set wb2 = Nothing

    Sheets("Tableau").Activate

End If

 End Sub

Le 17/05/2016 à 11:26

noemiesamira a écrit :
Et comment puis-je y remédier ?

Bonjour,

Déjà en commençant par joindre un fichier pour la bonne compréhension du problème. Car sans le fichier tester sera difficile.

Le 17/05/2016 à 11:27

J'ai rajouté le code pendant que tu rédigeais ta réponse. Si le fichier est vraiment nécessaire je peux le joindre en plus.

Le 17/05/2016 à 12:14

Bonjour,

If [B1] = 1 Or 2 And...

est faux

Remplacer par :

]If [B1] = 1 Or [B1] = 2 And...

et structures tes conditions avec des parenthèses si nécessaire :

If ([B1] = 1 Or  [B1] = 2) And [C1] = 3 And ... Then

eric

Le 17/05/2016 à 12:23

Bonjour a toi !

Tout d'abord merci pour ta réponse.

J'ai donc modifié le code comme tu me l'as montré, mais quand j'exécute la macro un message d'erreur apparait !

erreur d'exécution '5' : 
Argumennt ou appel de procédure incorrect

Option Explicit
Sub TEST_TRI()
'
' TEST_TRI Macro
' Macro enregistrée le 10/05/2016 par lycée

'Suppression TCD
  Sheets("Tableau").Activate
  Range("A1:Q300").Select
  Range("Q300").Activate
  Selection.Delete

  'Suppresion Liste
  Sheets("Liste").Activate
  Range("A1:L400").Select
  Range("L400").Activate
  Selection.Delete

    'Définition des critères pour CITEC
Sheets("Génération").Activate
If ([B1] = 1 And [B1] = 2) And [C1] = 3 And ([D1] = 1 And [D1] = 2) And ([E1] = 1 And [E1] = 2) And ([K1] = 1 And [K1] = 2) And ([L1] = 1 And [L1] = 2) Then

    'Filtre élaboré pour trier la BD élève
    Sheets("BD Eleves").Range("A1:L400").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Génération").Range("T4:AE5"), CopyToRange:=Sheets("Liste").Range( _
        "A1:L1"), Unique:=False

    Sheets("Liste").Select
    'Tri de la feuille Liste, par Option 4 puis 5
    Cells.Select
    Selection.Sort Key1:=Range("I2"), Order1:=xlAscending, Key2:=Range("H2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal

    'Déclaration des variables
    Range("A1").Select

 Dim wb As Workbook
Dim ws As Worksheet, ws2 As Worksheet
Dim PTCache As PivotCache
Dim pt As PivotTable
Dim rngPT As Range

    'Optimisation (Gel Affichage)
    Application.ScreenUpdating = False

    'Initialisation des variables
    Set wb = ActiveWorkbook
    Set ws = wb.Worksheets("Liste")
    Set rngPT = ws.Cells(1).CurrentRegion     'Données sources du TCD
    Set ws2 = wb.Worksheets("Tableau")
    'Suppression TCD
    On Error Resume Next
    ws2.PivotTables(1).TableRange2.Clear
    On Error GoTo 0

   'Création du cache de TCD (à partir de rngPT)
    Set PTCache = wb.PivotCaches.Add _
                  (SourceType:=xlDatabase, _
                   SourceData:=rngPT)

    'Création du TCD en feuille 'Tableau' nommé TCD_1
    Set pt = PTCache.CreatePivotTable _
             (tabledestination:=ws2.Cells(6, 2), _
              TableName:="TCD_1", _
              defaultversion:=xlPivotTableVersion10)
    With pt

    'Calcul TCD manuel (Optimisation)
        .ManualUpdate = True

    'Ajout des étiquettes de lignes et colonnes
        .AddFields RowFields:=Array("OPTION 4", "OPTION ECO"), _
                   ColumnFields:="SEXE"

     'Ajout champ valeurs
        With .PivotFields("NOM")
            .Orientation = xlDataField
            .Function = xlCount
            .NumberFormat = "#,##0"
            .Caption = "NB NOMS"
        End With

      'Calcul automatique (affiche le TCD)
        .ManualUpdate = False
    End With

    wb.ShowPivotTableFieldList = False

    With ws2
        .Activate
        .[A1].Select
    End With

    Set rngPT = Nothing
    Set pt = Nothing
    Set PTCache = Nothing
    Set ws2 = Nothing: Set ws = Nothing
    Set wb = Nothing

Sheets("Tableau").Activate

    'Définition des critères pour SC-IG

Sheets("Génération").Activate
ElseIf ([B1] = 1 And [B1] = 2) And [C1] = 9 And ([D1] = 1 And [D1] = 2) And ([E1] = 1 And [E1] = 2) And ([K1] = 1 And [K1] = 2) And ([L1] = 1 And [L1] = 2) Then

'Suppression TCD
  Sheets("Tableau").Activate
  Range("A1:Q300").Select
  Range("Q300").Activate
  Selection.Delete

  'Suppresion Liste
  Sheets("Liste").Activate
  Range("A1:L400").Select
  Range("L400").Activate
  Selection.Delete

    'Filtre élaboré pour trier la BD élève
    Sheets("BD Eleves").Range("A1:L400").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Génération").Range("T7:AE8"), CopyToRange:=Sheets("Liste").Range( _
        "A1:L1"), Unique:=False

    Sheets("Liste").Select
    'Tri de la feuille Liste, par Option 4 puis 5
    Cells.Select
    Selection.Sort Key1:=Range("I2"), Order1:=xlAscending, Key2:=Range("H2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal

    'Déclaration des variables
    Range("A1").Select

 Dim wb1 As Workbook
Dim ws3 As Worksheet, ws4 As Worksheet
Dim PTCache1 As PivotCache
Dim pt1 As PivotTable
Dim rngPT1 As Range

    'Optimisation (Gel Affichage)
    Application.ScreenUpdating = False

    'Initialisation des variables
    Set wb1 = ActiveWorkbook
    Set ws3 = wb1.Worksheets("Liste")
    Set rngPT1 = ws3.Cells(1).CurrentRegion     'Données sources du TCD
    Set ws4 = wb1.Worksheets("Tableau")
    'Suppression TCD
    On Error Resume Next
    ws4.PivotTables(1).TableRange2.Clear
    On Error GoTo 0

   'Création du cache de TCD (à partir de rngPT)
    Set PTCache1 = wb1.PivotCaches.Add _
                  (SourceType:=xlDatabase, _
                   SourceData:=rngPT1)

    'Création du TCD en feuille 'Tableau' nommé TCD_1
    Set pt1 = PTCache1.CreatePivotTable _
             (tabledestination:=ws4.Cells(6, 2), _
              TableName:="TCD_1", _
              defaultversion:=xlPivotTableVersion10)
    With pt1

    'Calcul TCD manuel (Optimisation)
        .ManualUpdate = True

    'Ajout des étiquettes de lignes et colonnes
        .AddFields RowFields:=Array("OPTION 4", "OPTION ECO"), _
                   ColumnFields:="SEXE"

     'Ajout champ valeurs
        With .PivotFields("NOM")
            .Orientation = xlDataField
            .Function = xlCount
            .NumberFormat = "#,##0"
            .Caption = "NB NOMS"
        End With

      'Calcul automatique (affiche le TCD)
        .ManualUpdate = False
    End With

    wb1.ShowPivotTableFieldList = False

    With ws4
        .Activate
        .[A1].Select
    End With

    Set rngPT1 = Nothing
    Set pt1 = Nothing
    Set PTCache1 = Nothing
    Set ws4 = Nothing: Set ws3 = Nothing
    Set wb1 = Nothing

    Sheets("Tableau").Activate

    'Définition des critères pour SES
Sheets("Génération").Activate
Else: [B1] = 4 And ([C1] = 1 And [C1] = 2) And ([D1] = 1 And [D1] = 2) And ([E1] = 1 And [E1] = 2) And ([K1] = 1 And [K1] = 2) And ([L1] = 1 And [L1] = 2)

'Suppression TCD
  Sheets("Tableau").Activate
  Range("A1:Q300").Select
  Range("Q300").Activate
  Selection.Delete

  'Suppresion Liste
  Sheets("Liste").Activate
  Range("A1:L400").Select
  Range("L400").Activate
  Selection.Delete

    'Filtre élaboré pour trier la BD élève
    Sheets("BD Eleves").Range("A1:L400").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Génération").Range("T17:AE18"), CopyToRange:=Sheets("Liste").Range( _
        "A1:L1"), Unique:=False

    Sheets("Liste").Select
    'Tri de la feuille Liste, par Option 4 puis 5
    Cells.Select
    Selection.Sort Key1:=Range("H2"), Order1:=xlAscending, Key2:=Range("I2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal

    'Déclaration des variables
    Range("A1").Select

 Dim wb2 As Workbook
Dim ws5 As Worksheet, ws6 As Worksheet
Dim PTCache2 As PivotCache
Dim pt2 As PivotTable
Dim rngPT2 As Range

    'Optimisation (Gel Affichage)
    Application.ScreenUpdating = False

    'Initialisation des variables
    Set wb2 = ActiveWorkbook
    Set ws5 = wb2.Worksheets("Liste")
    Set rngPT2 = ws5.Cells(1).CurrentRegion     'Données sources du TCD
    Set ws6 = wb2.Worksheets("Tableau")
    'Suppression TCD
    On Error Resume Next
    ws6.PivotTables(1).TableRange2.Clear
    On Error GoTo 0

   'Création du cache de TCD (à partir de rngPT)
    Set PTCache2 = wb2.PivotCaches.Add _
                  (SourceType:=xlDatabase, _
                   SourceData:=rngPT1)

    'Création du TCD en feuille 'Tableau' nommé TCD_1
    Set pt2 = PTCache2.CreatePivotTable _
             (tabledestination:=ws6.Cells(6, 2), _
              TableName:="TCD_1", _
              defaultversion:=xlPivotTableVersion10)
    With pt2

    'Calcul TCD manuel (Optimisation)
        .ManualUpdate = True

    'Ajout des étiquettes de lignes et colonnes
        .AddFields RowFields:="OPTION ECO", _
                   ColumnFields:=Array("OPTION 4", "SEXE")

     'Ajout champ valeurs
        With .PivotFields("NOM")
            .Orientation = xlDataField
            .Function = xlCount
            .NumberFormat = "#,##0"
            .Caption = "NB NOMS"
        End With

      'Calcul automatique (affiche le TCD)
        .ManualUpdate = False
    End With

    wb2.ShowPivotTableFieldList = False

    With ws6
        .Activate
        .[A1].Select
    End With

    Set rngPT2 = Nothing
    Set pt2 = Nothing
    Set PTCache2 = Nothing
    Set ws6 = Nothing: Set ws5 = Nothing
    Set wb2 = Nothing

    Sheets("Tableau").Activate

End If

 End Sub

Le 17/05/2016 à 12:59

Non seulement tu ne mets pas de fichier de test mais en plus tu ne dis même pas quelle ligne est en erreur. Aant cassé ma boule de cristal...

Et les ( ) ne se mettent pas au hasard ni pour faire joli avec une belle régularité. Il faut qu'elles correspondent exactement à ce que tu veux.

Par exemple :

([D1] = 1 And [D1] = 2) est strictement pareil avec ou sans. Au passage explique-moi quand [D1] peut être égal à 1 ET égal à 2 ???

Un peu de révision de tes cours de logique est nécessaire je pense.

Le 17/05/2016 à 13:33

Eriiic, en faisant défiler le code, vous remarquerez que la ligne qui bloque est surligné. Donc peut être que vos lunettes ont besoin d'une révision elles aussi.

J'ai suivi ce que vous me disiez, cela peut être égal à 1 OU 2, ce que j'avais écrit au début dans ma macro.

Je ne suis pas télépathe (ou pas encore du moins), je ne peux donc pas lire dans vos pensées, et si vous me dites que je peux faire de telle ou telle façon, je choisis celle que je préfère, donc pour éviter de faire des erreurs, ou pour ne pas critiquer par la suite, pensez à bien expliquer, car si quelqu'un se tourne vers vous, c'est qu'il ne sait pas forcément, et tout le monde n'est pas un pro de la programmation.

De plus, dans un post-réponse j'ai bien précisé que SI le fichier était nécessaire je pouvais le joindre. En avez-vous fait la demande ? Il ne me semble pas. Merci donc de surveiller vos dire.

Je vous prierai donc, de bien regarder, de lire, et de comprendre avant de répondre, et avant de juger ou donner des conseils, de bien lire également.

Le 17/05/2016 à 13:49

J'ai fait les modifications sur la macro, j'ai trouvé des zones d'erreurs, que j'ai traité, seulement maintenant, un nouveau message erreur s'affiche :

Erreur d'exécution 1004
Cette commande requiert au moins deux lignes de données sources. Vous ne pouvez pas l’utiliser sur une seule ligne de données.
Essayez la méthode suivante : 
- Si vous utilisez un filtre élaboré, sélectionnez une plage de cellules qui contient au moins deux lignes de donnée. Puis cliquez à nouveau sur la commande filtre élaboré.

'Définition des critères pour SES
Sheets("Génération").Activate
Else: [B1] = 4 And ([C1] = 1 Or [C1] = 2) And ([D1] = 1 Or [D1] = 2) And ([E1] = 1 Or [E1] = 2) And ([K1] = 1 Or [K1] = 2) And ([L1] = 1 Or [L1] = 2)

'Suppression TCD
  Sheets("Tableau").Activate
  Range("A1:Q300").Select
  Range("Q300").Activate
  Selection.Delete

  'Suppresion Liste
  Sheets("Liste").Activate
  Range("A1:L400").Select
  Range("L400").Activate
  Selection.Delete

    'Filtre élaboré pour trier la BD élève
    Sheets("BD Eleves").Range("A1:L400").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Génération").Range("T17:AE18"), CopyToRange:=Sheets("Liste").Range( _
        "A1:L1"), Unique:=False

    Sheets("Liste").Select
    'Tri de la feuille Liste, par Option 4 puis 5
    Cells.Select
    Selection.Sort Key1:=Range("H2"), Order1:=xlAscending, Key2:=Range("I2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal

    'Déclaration des variables
    Range("A1").Select

 Dim wb2 As Workbook
Dim ws5 As Worksheet, ws6 As Worksheet
Dim PTCache2 As PivotCache
Dim pt2 As PivotTable
Dim rngPT2 As Range

    'Optimisation (Gel Affichage)
    Application.ScreenUpdating = False

    'Initialisation des variables
    Set wb2 = ActiveWorkbook
    Set ws5 = wb2.Worksheets("Liste")
    Set rngPT2 = ws5.Cells(1).CurrentRegion     'Données sources du TCD
    Set ws6 = wb2.Worksheets("Tableau")
    'Suppression TCD
    On Error Resume Next
    ws6.PivotTables(1).TableRange2.Clear
    On Error GoTo 0

   'Création du cache de TCD (à partir de rngPT)
    Set PTCache2 = wb2.PivotCaches.Add _
                  (SourceType:=xlDatabase, _
                   SourceData:=rngPT2)

    'Création du TCD en feuille 'Tableau' nommé TCD_1
    Set pt2 = PTCache2.CreatePivotTable _
             (tabledestination:=ws6.Cells(6, 2), _
              TableName:="TCD_1", _
              defaultversion:=xlPivotTableVersion10)

    With pt2

    'Calcul TCD manuel (Optimisation)
        .ManualUpdate = True

    'Ajout des étiquettes de lignes et colonnes
        .AddFields RowFields:="OPTION ECO", _
                   ColumnFields:=Array("OPTION 4", "SEXE")

     'Ajout champ valeurs
        With .PivotFields("NOM")
            .Orientation = xlDataField
            .Function = xlCount
            .NumberFormat = "#,##0"
            .Caption = "NB NOMS"
        End With

      'Calcul automatique (affiche le TCD)
        .ManualUpdate = False
    End With

    wb2.ShowPivotTableFieldList = False

    With ws6
        .Activate
        .[A1].Select
    End With

    Set rngPT2 = Nothing
    Set pt2 = Nothing
    Set PTCache2 = Nothing
    Set ws6 = Nothing: Set ws5 = Nothing
    Set wb2 = Nothing

    Sheets("Tableau").Activate

End If

 End Sub

11repartition-eleves-copie.zip (47.72 Ko)

Le 17/05/2016 à 16:12

Je crois rêver...

C'est à moi de deviner qu'il faut faire défiler 100 lignes de programme pour voir qu'il y en a 1 que tu as surlignée ?

Et je passe sur le reste totalement incongru, il aurait trop à dire...

Je vais donc m'en tenir là et surtout ne te remet pas en cause.

eric

Le 17/05/2016 à 16:20

C'est de la logique, pas une devinette. Comme tu sais si bien le dire.

C'est effarant de voir des personnes comme toi, qui se croit au dessus des autres..

En tout cas, merci de ta petite aide, et de tes nombreuses reproches, cela me fait me sentir moins con et ingrate envers les personnes qui m'entourent.

Rechercher des sujets similaires à "conditions qui execute mal"