lister les villes de meme nom a partir d'une base de données

matou59

XLDnaute Junior
Bonjour,
A partir de ma base de donnees composee de 6 colonnes comme suit:
A B C D E F
NOM VILLE CODE POSTAL N° DEPARTEMENT NOM DEPARTEMENT CHEF LIEU NOM REGION

CE QUI REPRESENTE ENVIRON 35000 ENREGISTREMENTS.......

JE VOUDRAIS LISTER TOUS LES ENREGISTREMENTS DONT LES NOMS DE VILLE SONT IDENTIQUES

ma base de donnees se trouve dans une feuille d'un classeur appelée VILLES
Je veux lister les enregistrements identiques dans une 2e feuille du meme classeur appelée RESULTAT

Faire un filtre sur la base de données est beaucup trop long....35000 enregistrements c'est pas rien....

merci d'avance
 

MJ13

XLDnaute Barbatruc
Re : lister les villes de meme nom a partir d'une base de données

Re

Incroyable ça !! Tu as bien fermé tous les autres fichiers avant de tester ?

Car ça pourrait venir de formules qui se recalculent...

Job: oui, 2 fois de suite, j'ai eu le même ordre de grandeur :confused:.

Sinon , j'ai bien tenté avec un TCD, mais c'est galère :(.
 

MJ13

XLDnaute Barbatruc
Re : lister les villes de meme nom a partir d'une base de données

Re

Bon sinon, en cherchant un peu et en regardant XL2007 dans le blanc des onglets :eek:, j'ai trouvé, non pas pour lister les doublons, mais pour supprimer les doublons sur XL2007 (cela doit être pareil sur XL2010).

Et la , dans l'onglet données, on a un gros bouton qui s'appelle Supprimer les doublons. Cela a l'air assez puissant (mais penser à faire une copie de votre feuille avant de l'utiliser :eek:).

Voila si on en a besoin, maintenant, on sait que cela existe :).
 
Dernière édition:

MJ13

XLDnaute Barbatruc
Re : lister les villes de meme nom a partir d'une base de données

Bonjour à tous

Bon, j'ai continué les tests pour extraire les doublons :(.

J'ai retenu 3 codes: les 2 de JB et celui de Job que voici (test sur XL2007, cela a son importance ;)):

Les temps sur 6 colonnes sur une vrai BD des villes de France de 38950 lignes sont d'environ:

15 secondes pour le code de Job, 22 secondes pour celui de JB et 1,5 secondes pour celui de JB rapide.

Mais celui de Job peut avoir un avantage, c'est qu'il garde la mise en forme.
Donc, tous ces codes sont intéressant :).

PS: je n'ai pas gardé les codes de David et de moi, car ils étaient trop long sur mes tests (j'ai même pas testé le mien :().

Code:
Sub VillesDoublons()
'Job
t1 = Timer
With Sheets("RESULTAT")
  Application.ScreenUpdating = False
  Sheets("VILLES (2)").Cells.Copy .Cells
  .[A2:G65536].Sort Key1:=.[A2], Order1:=xlAscending, Header:=xlYes 'tri sur les noms
  .[3:3].Insert 'insertion de ligne nécessaire...
  .[G3].Formula = "=AND($A3<>$A2,$A3<>$A4)"
  .[H3] = True
  .[A2:G65536].AdvancedFilter xlFilterInPlace, CriteriaRange:=.[G2:G3]
  .[A3:G65536].SpecialCells(xlCellTypeVisible).Delete xlUp
  .[A2:G65536].AdvancedFilter xlFilterInPlace, CriteriaRange:=.[H2:H3]
  .[G3:G3].ClearContents
  .[3:3].Delete
  .Activate
End With
  MsgBox (Timer - t1)
End Sub
Sub ListeVillesDoublons()
'JB
t1 = Timer
  Set f1 = Sheets("villes (2)")
  Set f2 = Sheets("resultat")
  Set champ = f1.Range("A3:G" & f1.[A65000].End(xlUp).Row)
  Set mondico = CreateObject("Scripting.Dictionary")
  f2.[A1:G65000].ClearContents
  For Each c In champ
    mondico.Item(c.Value) = mondico.Item(c.Value) + 1
  Next c
  ligne = 1
  For Each c In champ
    If mondico.Item(c.Value) > 1 Then
      c.Resize(, 6).Copy f2.Cells(ligne, 1)
      ligne = ligne + 1
    End If
  Next c
  f2.[A1].CurrentRegion.Sort Key1:=f2.[A1], Order1:=xlAscending, Header:=xlNo
  MsgBox (Timer - t1)
End Sub
Sub ListeVillesDoublonsRapide()
'JB
t1 = Timer
  Set f1 = Sheets("villes (2)")
  Set f2 = Sheets("resultat")
  a = f1.Range("A3:G" & f1.[A65000].End(xlUp).Row).Value
  Set mondico = CreateObject("Scripting.Dictionary")
  f2.[A1:G65000].ClearContents
  For i = 1 To UBound(a)
    mondico.Item(a(i, 1)) = mondico.Item(a(i, 1)) + 1
  Next i
  ligne = 1
  Dim c()
  ReDim c(1 To UBound(a, 1), 1 To UBound(a, 2))
  For i = 1 To UBound(a)
    If mondico.Item(a(i, 1)) > 1 Then
      For k = 1 To UBound(a, 2): c(ligne, k) = a(i, k): Next k
      ligne = ligne + 1
    End If
  Next i
  f2.[A1].Resize(mondico.Count, UBound(a, 2)) = c
  f2.[A1].CurrentRegion.Sort Key1:=f2.[A1], Order1:=xlAscending, Header:=xlNo
  MsgBox (Timer - t1)
End Sub
 

job75

XLDnaute Barbatruc
Re : lister les villes de meme nom a partir d'une base de données

Bonjour le fil, le forum,

Après discussions en privé avec Michel, il semble que sur son Excel 2007 les opérations d'insertion/suppression prennent du temps.

Voyez donc cette nouvelle macro (la précédente n'était d'ailleurs pas vraiment correcte) :

Code:
Sub VillesDoublons()
Dim plage As Range
With Sheets("resultat")
  Application.ScreenUpdating = False
  Sheets("villes").Cells.Copy .Cells
  Set plage = .Range("A2:F" & .[A65536].End(xlUp).Row)
  plage.Sort Key1:=.[A2], Order1:=xlAscending, Header:=xlYes 'tri sur les noms
  .[G3].Formula = "=ISERR(LN(A3=A2))*ISERR(LN(A3=A4))"
  plage.AdvancedFilter xlFilterInPlace, CriteriaRange:=.[G2:G3]
  plage.Offset(1).SpecialCells(xlCellTypeVisible).Delete xlUp
  .[G3] = True
  plage.AdvancedFilter xlFilterInPlace, CriteriaRange:=.[G2:G3]
  .[G3] = ""
  .Activate
End With
End Sub

Le critère de filtrage en G3 utilise ESTERR qui évite les problèmes aux 2 extrêmités de la plage :

=ESTERR(LN(A3=A2))*ESTERR(LN(A3=A4))

Fichier (2) joint et testez aussi le fichier sur cijoint.fr :

Cijoint.fr - Service gratuit de dépôt de fichiers

Quelle durée d'exécution obtiens-tu maintenant Michel ?

Edit : si l'on est pinailleur, ajouter On Error Resume Next :

.[G3] = True
On Error Resume Next 'si toutes les villes ont été supprimées (pas de doublon)...
plage.AdvancedFilter xlFilterInPlace, CriteriaRange:=.[G2:G3]


A+
 

Pièces jointes

  • VILLES(2).xls
    38.5 KB · Affichages: 37
Dernière édition:

job75

XLDnaute Barbatruc
Re : lister les villes de meme nom a partir d'une base de données

Re,

Eh bien Michel et moi nous avons trouvé :D

Ce qui prenait beaucoup de temps sur l'Excel 2007 de Michel, c'est le 2ème filtrage (qui affiche tout).

En fait il faut utiliser à la place .ShowAllData qui est très rapide :

Code:
Sub VillesDoublons()
Dim plage As Range
With Sheets("resultat")
  Application.ScreenUpdating = False
  Sheets("villes").Cells.Copy .Cells
  Set plage = .Range("A2:F" & .[A65536].End(xlUp).Row)
  plage.Sort Key1:=.[A2], Order1:=xlAscending, Header:=xlYes 'tri sur les noms
  .[G3].Formula = "=ISERR(LN(A3=A2))*ISERR(LN(A3=A4))"
  plage.AdvancedFilter xlFilterInPlace, CriteriaRange:=.[G2:G3]
  plage.Offset(1).SpecialCells(xlCellTypeVisible).Delete xlUp
  .[G3] = ""
  .ShowAllData
  .Activate
End With
End Sub

Fichier (3) joint et sur cijoint.fr :

Cijoint.fr - Service gratuit de dépôt de fichiers

je trouve sur Excel 2003 => 0,60 s, Excel 2010 => 0,42 s.

Attendons le résultat de Michel.

A+
 

Pièces jointes

  • VILLES(3).xls
    38.5 KB · Affichages: 45

MJ13

XLDnaute Barbatruc
Re : lister les villes de meme nom a partir d'une base de données

Re

Eh bien Michel et moi nous avons trouvé

Enfin gâce à moi, c'est un bien grand mot :eek:.

J'ai fait le test sur ton fichier avec environ 36000 données, c'est très rapide 0.8 seconde environ ;).

Mais si je rajoute par exemple 10 000 communes en plein milieu du fichier, on passe à 24 secondes et sur mon fichier de communes avec les 38000, on est a 40 secondes par rapport aux 60 secondes d'avant, je considère que c'est déjà très bien . Car on a rarement de si grosses basse de données ;).

C'est pour cela que j'essaie toujours de faire des tests en condition réelle.

Encore merci Job et bonne soirée :).
 

Discussions similaires

Statistiques des forums

Discussions
312 322
Messages
2 087 289
Membres
103 508
dernier inscrit
max5554