Discussion :

[Invité]

Bonsoir,

Il m'arrive quelque fois de donner une solution clé en main, quand le processus sort des sentiers battus et qu'il me semble difficile au demandeur dz le mètre en oeuvre .

Maintenant il me semble avoir bien épuré la question.
La réponse ce trouve dans couleur_sur_doublons_test "B", 4
NewFeulle_sur_doublons_test "A"

Qu'il faudra l'égerment modifier. Fais déjà un travail de compréhension et je t'expliquai comment modifier les requête et le filtre.

Par contre le fait que le résultat s'affiche trois fois me semble aberrent alors qu'il pourrait apparaitre qu'une fois avec le nombre d'occurrences .

[jpvba]

Bien répondu cher ami !!!!

[SBAY3I]

Bonsoir,

Il m'arrive quelque fois de donner une solution clé en main, quand le processus sort des sentiers battus et qu'il me semble difficile au demandeur dz le mètre en oeuvre .

Maintenant il me semble avoir bien épuré la question.
La réponse ce trouve dans couleur_sur_doublons_test "B", 4
NewFeulle_sur_doublons_test "A"

Qu'il faudra l'égerment modifier. Fais déjà un travail de compréhension et je t'expliquai comment modifier les requête et le filtre.

Par contre le fait que le résultat s'affiche trois fois me semble aberrent alors qu'il pourrait apparaitre qu'une fois avec le nombre d'occurrences .

merci beaucoup pour ta réactivité

[SBAY3I]

salut a tous
@jpvba et @dysorthographie je veux partage avec vous un autre code qui çammarche bien avec ma propre cas, le code de notre ami PCI adhérent dans autre forum anglophone.

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
Option Explicit
 
Sub Treat1()
Dim NomDic   As Object
Set NomDic = CreateObject("Scripting.Dictionary")
Dim Rg  As Range
Dim K, KK
Dim I  As Integer
 
    Application.ScreenUpdating = False
    With NomDic
        For Each Rg In Range("C2:C" & Cells(Rows.Count, "C").End(3).Row)
            If (.exists(Rg.Value)) Then
                If (.Item(Rg.Value).exists(Rg(1, 0).Value)) Then
                    .Item(Rg.Value).Item(Rg(1, 0).Value) = .Item(Rg.Value).Item(Rg(1, 0).Value) + 1
                Else
                     .Item(Rg.Value).Item(Rg(1, 0).Value) = 1
                End If
            Else
                Set .Item(Rg.Value) = CreateObject("Scripting.Dictionary")
                .Item(Rg.Value).Item(Rg(1, 0).Value) = 1
            End If
        Next Rg
 
        Range("D2:D" & Cells(Rows.Count, "D").End(3).Row + 1).Resize(, 3).ClearContents
        I = 1
        For Each K In .keys
            For Each KK In .Item(K).keys
                If ((.Item(K).Item(KK) <> 1) Or (.Item(K).Count > 1)) Then
                    I = I + 1
                    Cells(I, "D") = KK
                    Cells(I, "E") = K
                    Cells(I, "F") = .Item(K).Item(KK)
                End If
            Next KK
            If ((.Item(K).Count = 1) And (.Item(K).Item(KK) <> 1)) Then
                .Remove (K)
            End If
        Next K
        For Each Rg In Range("C2:C" & Cells(Rows.Count, "C").End(3).Row)
            Rg.Interior.Pattern = xlNone
            If (.exists(Rg.Value)) Then Rg(1, 0).Resize(1, 2).Interior.ColorIndex = 6
        Next Rg
    End With
    Application.ScreenUpdating = True
End Sub

merci a tous

[Invité]

Bonjour,
C'est la même solution qu'au poste #5 inspiré d'une source de Jacques Boigontier , pour qui j'ai beaucoup de respect.

Je lui reprocher seulement de faire une double passe. Une pour enrichir le dictionnaire et une autre pour actualisé Excel.

Si je j'utilise une requête Sql qui d'une certaine manière fait la même chose, c'est parce que ADO le fait en assembleur et donc plus rapide que VBA.

Certains me dirons qu'ADO ne marche pas sur MAC et je répondrai que les dictionnaire, qui était bien le postulat de départ, non plus.

[SBAY3I]

merci beucoup pour ta reponse, en fait je ne pouvais pas activer le code de poste #5, j'ai taper le nom (doublons_couleur_unique) mais çammarche pas

Bonjour,
C'est la même solution qu'au poste #5 inspiré d'une source de Jacques Boigontier , pour qui j'ai beaucoup de respect.

Je lui reprocher seulement de faire une double passe. Une pour enrichir le dictionnaire et une autre pour actualisé Excel.

Si je j'utilise une requête Sql qui d'une certaine manière fait la même chose, c'est parce que ADO le fait en assembleur et donc plus rapide que VBA.

Certains me dirons qu'ADO ne marche pas sur MAC et je répondrai que les dictionnaire, qui était bien le postulat de départ, non plus.

[jpvba]

De mon côté SBAY3I pour le cas auquel tu voudrais avoir les doublons dans la meme feuille j'aurais été avec une vlookup modifié que l'on m'a aidé a construire lors de postes antérieurs.


Cependant cette solution ne donne pas le nombre de fois mais plutot répète le nombre de fois que le terme apparais. Je te conseil de fouillé sur le forum sinon, je vais tenter de mettre le code dans un commentiare a ce poste

[jpvba]

De mon coté, je n'ai pas réussis a modifier la ligne

Code :

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

Set rs = .Execute("Select count([F1]),[F1] from [feuille_voulu" & Adresse & "] where [F1]  is not null group by [F1] having count([F1])>1")

afin feuille_voulu sois une variable et non un nom de feuille existant


Est-ce que vous avez un autre piste de solutions ???

[Invité]

Bonsoir,

Code :

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

1
2
3
4
5
6
Adresse="$A$1:$A$10"
"[feuille_voulu$" & replace(Adresse,"$","") & "]"
 
Nom="feuille_voulu"
Adresse = Replace(.Range(.Cells(1, col), .Cells(Rows.Count, col).End(xlUp)).Address, "$", "")
Set rs = .Execute("Select count([F1]),[F1] from [" & Nom & "$" & Adresse & "] where [F1]  is not null group by [F1] having count([F1])>1")

[jpvba]

Donc si j'applique la modification a ce que je veux j'arrive a ce résultats (je n'ai pas fixer l'adresse étant donné que je veux la totalité de la colonne et le nom est égale au paramètre feuille_voulu)

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
Sub feuille_sommaire_doublons_2(ByVal col As String, feuille_voulu As String)
Dim Adresse As String: Adresse = Replace(Range(Cells(1, col), Cells(Rows.Count, col).End(xlUp)).Address, "$", "")
Dim rs As Object
Dim f As Object
Dim wbk_creation As Workbook
 
Set wbk_creation = ActiveWorkbook
 
If sheetExists("sommaire_doublons") = True Then
        Application.DisplayAlerts = False
        Sheets("sommaire_doublons").Delete
        Application.DisplayAlerts = True
End If
 
If Not CBool(InStr(Adresse, ":")) Then Exit Sub
wbk_creation.Sheets(feuille_voulu).Select
With CreateObject("Adodb.connection")
    .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & wbk_creation.FullName & ";Extended Properties=""Excel 12.0;HDR=no;"""
    Set rs = .Execute("Select count([F1]),[F1] from [" & feuille_voulu & "$" & Adresse & "] where [F1]  is not null group by [F1] having count([F1])>1")
 
If Not rs.EOF Then
    Set f = wbk_creation.Sheets.Add: f.Cells(1, "A").CopyFromRecordset rs
    ActiveSheet.Name = "sommaire_doublons"
 
End If
    rs.Close
    .Close
 
 End With
 
 
End Sub

Code :

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

1
2
3
4
5
Sub test()
 
feuille_sommaire_doublons_2 "A", "Feuil1"
 
End Sub

La première exécution tous va sur des roulettes !!! La seconde exécution, la feuille sommaire_doublons n'est plus présente (donc elle est détruite mais pas recréé). La 3eme exécution tous marche a merveille, ainsi de suite

La Feuil1 a les données suivantes



La Feuil6 a les données suivants :



Si je parametre la sub test ainsi a fin de faire l'exercise avec la feuille 6

Code :

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

1
2
3
4
5
Sub test()
 
feuille_sommaire_doublons_2 "A", "Feuil6"
 
End Sub

La première exécution, tous marche comme il se doit, la feuille sommaire_doublons est créés avec 2 a, 2 b, 2 c. La seconde exécution, la feuille sommaire_doublons contient seulement 2 a ... c'Est là que tout est bizzare !!! La 3eme exécution, la feuille sommaire_doublons n'est plus présente. La 4eme exécution le tout est redevenu a la normale



JE me pose plusieurs questions mais je ne commprends pas pourquoi je n'arrive toujours pas au meme résultats.



J'ai essayé a nouveau

Code :

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

feuille_sommaire_doublons_2 "A", "Feuil6"

entre chaque exécution, je change de feuille et la tous marche parfaitement


merci encore pour votre aide !!!

[jpvba]

merci beucoup pour ta reponse, en fait je ne pouvais pas activer le code de poste #5, j'ai taper le nom (doublons_couleur_unique) mais çammarche pas

Il faut exécuter le tous dans un autre sub afin de pouvoir donner le parametre ....

[Invité]

En fait thisworkbook est le fichier qui exécute la macro. Thisworkbook.fullname retourne le chemin complet du fichier qui exécute la macro

J'effectues ma connexion Data Source=" & ThisWorkbook.FullName

Je défis si la.première ligne est le nom.de champs HDR=yes/no;"""

Si no la première colonne de la plage considérée est [F1] la deuxième [F2] [Etc...]

Si yes alors la première ligne est le nom.de chams [Nom],[Pnom],[Etc...]

Une requête est une description

Je sélectionne [F1],[F2] de la Feuille$
Je filtre sur la valeur toto de [F1]
Je regroupe.mes champs [F1],[F2]
Je fait un dixième filtre suis mon regroupement

Le croup by permet de faire de statiques cunt,min,max,moye etc...
Le having des filtre sur ces même statistiques.

Select (chemps)
From table
Where expression
Group by champs
Having expression

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
Select count([F1]),[F1],[F2]
From [Feuill1$]
Where [F1]='toto'
Group by [F1],[F2]
Having count([F1])>1
 
Select count([F1]),[F1],[F2],[F3]
From [Feuill1$]
Where [F1]='toto'
Group by [F1],[F2],[F3]
Having count([F1[)>1

[jpvba]

Juste un peu avant la notification du courriel,


J'ai réussis a avoir le bon résultat avec ceci

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
Function feuille_sommaire_doublons(ByVal col As String, feuille_voulu As String)
Dim Adresse As String
Dim rs As Object
Dim f As Object
Dim wbk_creation As Workbook
 
Set wbk_creation = ActiveWorkbook
 
 
If sheetExists("sommaire_doublons") = True Then
        Application.DisplayAlerts = False
        Sheets("sommaire_doublons").Delete
        Application.DisplayAlerts = True
End If
 
Sheets(feuille_voulu).Activate
Adresse = Replace(Range(Cells(1, col), Cells(Rows.Count, col).End(xlUp)).Address, "$", "")
 
 
If Not CBool(InStr(Adresse, ":")) Then Exit Function
 
 
With CreateObject("Adodb.connection")
    .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & wbk_creation.FullName & ";Extended Properties=""Excel 12.0;HDR=no;"""
    Set rs = .Execute("Select count([F1]),[F1] from [" & feuille_voulu & "$" & Adresse & "] where [F1]  is not null group by [F1] having count([F1])>1")
 
If Not rs.EOF Then
    Set f = wbk_creation.Sheets.Add: f.Cells(1, "A").CopyFromRecordset rs
    ActiveSheet.Name = "sommaire_doublons"
 
End If
    rs.Close
    .Close
 
 End With

l'adresse prenait la valeur de la feuille active.



Je vais également jeter un oeil a votre solution

[Pierre Fauconnier]

Salut.

Ma question est: Pourquoi passer par du VBA? La mise en forme conditionnelle fait cela très bien, je pense... Et si on veut passer par du VBA (gestion de la plage concernée, ...), on met en place la MFC par VBA

[jpvba]

Salut.

Ma question est: Pourquoi passer par du VBA? La mise en forme conditionnelle fait cela très bien, je pense... Et si on veut passer par du VBA (gestion de la plage concernée, ...), on met en place la MFC par VBA

Bonjour monsieur Fauconnier

Lorsque que l'on copie des éléments d'une feuille a une autre la mise en forme conditionnelle est altéré. Il faut toujours re-sélectionner la plage en question. Également il y a une question d'efficacité en terme de temps, il est plus rapide d'automatisé certains élément que les répétés 100 de fois. Si on peut sauver 5 minutes par personne par jour pendant un an, on gagne énormément de performance !!!! Également la MFC ne permet pas de regrouper les doublons par couleur ce que VBA peut faire. Dans des donnés similaire le regroupement peut aider la prise de décisions

Dans mon contexte de travail, j'ai absolument un fort gain. Certes pour d'autre situation effectivement la MFC semble être plus simple. Dans mon contexte beaucoup de gens malheureusement ne sont pas énormément "bon" dans excel pour des chose vraiment basique tel que faire une recherchev, concaténer 2 champs utilisé un si, etc... malheureusement nous devons parfois pallier a ce manque par des alternatives. Oui il est préférable d'apprendre a pecher, mais parfois l'employeur ne fournis pas les cannes a peche, appâts et matos et ne demande pas si les personnes savent pêcher avant d'embarquer dans le bateau. L'employeur a besoin de poisson et de plus en plus


Cette amalgame de situation fait en sorte que pour moi cette discussion est vraiment précieuse et qu'elle est surement également une richesse pour d'autre membre/visiteur du forum.


mes salutations


jp

[Pierre Fauconnier]

Comme souvent, c'est un problème de conception à la base. Si on a besoin de ces gesticulations en VBA, c'est qu'on utilise mal l'outil, et il serait alors préférable de revoir la conception du classeur. Mais bon, je vais encore me faire allumer par certains, alors que j'ai raison. Une bonne conception et ce n'est pas 5 minutes, mais des heures qui seront gagnées, avec en plus une fiabilité, une sécurité et une stabilité accrue

Cela dit, tant mieux si la solution te convient.

[jpvba]

Bonjour Monsieur Fauconnier,


Je vois votre point et le comprends, le respect mais je ne suis pas tout a fait d'accord avec celui-ci.


Dans certains cas oui, il s'agit de concept mais dans certains cas non, il ne faut pas généralisé. Regarder le tout avant de faire des manipulations, codes est effectivement ce qu'il faut faire, un analyse du besoin et résultat voulu, c'Est la clée du succès.

Quand on part de rien oui on peut se permettre la remise en question mais dans certains cas, nous partons d'extraction d'un logiciel auquel nous ne pouvons pas personnalisé le tout.


Sur ce avant d'éclater dans un combat d'idée, oui les solutions me conviennent énormément et l'aide fournis par les autres membres sont plus que cruciales.


là dessus mes salutations cher ami et au plaisir de ce reparler

[Pierre Fauconnier]

Tant pis pour le combat d'idées...

Si on ne peut pas personnaliser l'extraction (je comprends, je pends tous les matins un "consultant" SAP qui n'a pas encore compris comment fonctionne Excel), on personnalise APRES...

Autrement dit, on crée une passerelle entre l'extraction pourrie et l'application que l'on souhaite réaliser en Excel, mais on ne "bricole" pas des solutions aberrantes en VBA pour pallier une mauvaise étude/conception/analyse. Je n'ai JAMAIS eu besoin, en plus de 20 ans de travail quotidien avec Excel lié à des données externes, de créer une "MFC" en passant par un dictionnaire en vba parce que mes plages bougeaient toutes seules. JAMAIS...

Mais puisque tu aimes les usines à gaz, je ne veux pas te priver. Amuse-toi (enfin, quand je dis "amuse-toi", je me comprends)

[jpvba]

Je respecte votre opinion et comprends votre point de vue.


JE ne vous dit pas que vous avez tard en terme de concept , etc ... Meme je crois que vous avez raisons. JE dois malheureusement subir la situation, donc oui a première vue une usine a gaz.


désolé de ne pas vouloir plus m'obstiner, je vie présentement un deuil et j'ai pas d'énergie psychologique a me débattre. Vous avez raison en terme du concept mais il y a la "politique" qui viens biaisé le tir.


amicalement JP