Discussion :

[taha-ba]

Bonjour, dans un fichier excel j'ai une liste de voudrais détecter les codes fonctions dont le nombre de S1 égale le nombre des S2. je voudrais afficher dans ne autre liste tous les codes fonctions dont le nombre des S1 n'égale pas S2.

je voudrais faire une macro car dans mon fichier d'origine j'ai un tableau qui contient 6000 lignes qui rend la tâche plus difficile.
CODE DE FONCTION.xlsx

Vous trouverez le fichier en PJ.
Par exemple dans le fichier je voudrais afficher dans une liste CF1 et CF3 puisque c'est sont les codes de fonction dont le nombre de S1 n’égale pas celui de S2

[BENNASR]

bonjour
sans VBA

1 - Clic en A1 puis onglet INSERTION / Tableau
2 - Clic dans ton tableau puis clic onglet Insertion / TblCroiséDynamique / TblCroiséDynamique
3- choisir dans la feuille encours ou bien nouvelle feuille
4 - en ligne code fonction / en colonne semaine / en valeur REFERENCE (en tant que nombre comme format)
5 - dans la colonne S2 clic droite puis paramètre champs de valeur : afficher les valeur / différence par rapport / choisir S1
et à chaque mise à jours des données cliquer dans le tableau et puis actualiser
n'hésitez pas de revenir si c'est pas claire
Bonne continuation

[taha-ba]

Merci beaucoup pour votre aide, j'ai déjà travaillé avec les tableaux croisés dynamiques mais dans mes tableaux d'origines j'ai 6500 ligne c'est pour cela que je voudrais afficher que les CF avec diff <> 0.

[BENNASR]

je t'assure qu'avec un TCD y a aucun problème de temps d'exécution ni de nombre de ligne
Pour travailler avec les valeur différent de zéro faite un simple filtre et tu aura ton résultat
Bonne continuation

[taha-ba]

J'ai essayé de faire un filtre mais je n'ai pas pu, vous avez une idée comment éliminer les 0 de la liste des différences ?

[taha-ba]

Bonjour je pense pas qu'on puisse faire un filtre sur la colonne des différence. j'ai essayé mais je peux pas faire.

[BENNASR]

avec VBA
ajouter un onglet nommé "RESULTAT" et tester ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Sub regroup2()
Application.ScreenUpdating = False
Dim f1 As Worksheet
Dim f2 As Worksheet
 
Set f1 = Sheets("Sheet1")
Set f2 = Sheets("RESULTAT")
f2.Cells.ClearContents
Dim i As Long
 
Set d = CreateObject("Scripting.Dictionary")
    '**********************************************************
    TblBD = f1.Range("A2:D" & f1.Range("C" & Rows.Count).End(xlUp).Row)
    For i = 1 To UBound(TblBD)
    X = 0
    clé = TblBD(i, 2)
    If TblBD(i, 3) = "S1" Then d(clé) = d(clé) + (X + 1)
  Next i
  f2.Range("A2").Resize(d.Count) = Application.Transpose(d.keys)
  f2.Range("B2").Resize(d.Count) = Application.Transpose(d.items)
 
 
  Set d2 = CreateObject("Scripting.Dictionary")
    '**********************************************************
    TblBD = f1.Range("A2:D" & f1.Range("C" & Rows.Count).End(xlUp).Row)
    For i = 1 To UBound(TblBD)
    X = 0
    clé = TblBD(i, 2)
    If TblBD(i, 3) = "S2" Then d2(clé) = d2(clé) + (X + 1)
  Next i
  f2.Range("A2").Resize(d2.Count) = Application.Transpose(d2.keys)
  f2.Range("C2").Resize(d2.Count) = Application.Transpose(d2.items)
 
 f2.Cells(1, 1) = "Référence"
 f2.Cells(1, 2) = "S1"
 f2.Cells(1, 3) = "S2"
 f2.Cells(1, 4) = "Différence"
 
  'Calculer différence différence
  For ligne = 2 To f2.Range("A" & Rows.Count).End(xlUp).Row
  f2.Cells(ligne, 4) = f2.Cells(ligne, 3) - f2.Cells(ligne, 2)
  Next ligne
 
  'supprimer ligne égal à zéro
  For i = f2.Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
    If f2.Cells(i, 4) = 0 Then
    f2.Cells(i, 1).EntireRow.Delete
    End If
 Next i
 
Application.ScreenUpdating = True
f2.Select
End Sub

tester avec prudence sur une copie de ton fichier pour munir contre tous risque de perte de données

[taha-ba]

Bonjour Bennaser, le programme fonctionne parfaitement. MERCI pour vos efforts.

[BENNASR]

merci de cliquer sur RESOLU en bas
bonne continuation