Tri ne s'effectuant pas complétement et sélection Nom pas entiére

[JBARBE]

Bonjour à tous,

Faisant suite à ce post :
https://www.excel-downloads.com/threads/les-communes-de-france.20015393/
Je ne comprends pas que le tri ne s’effectue pas entièrement dans la feuille "ville" !
De plus, dans la feuille 1, cellule A2 tout les noms des villes ne sont pris en compte !
Merci & Bonne journée !

 

[Caillou]

Bonjour,

Pour le tri dans la feuille "ville", certaines villes (la plupart) contiennent un espace au début ! il faut supprimer les espaces superflus avec la fonction SUPPRESPACE par exemple.
Pour la liste, sauf erreur de ma part, une liste de validation est limitée à 32768 éléments !
Il faudrait essauer avec un controle ActiveX (combobox) peut-être.

Caillou

 

[job75]

Bonjour JBARBE, salut Caillou,

Ton fichier en retour avec cette macro dans le code de la 1ère feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a, cible$, i&, n&, b()
With Feuil2.[A1].CurrentRegion.Resize(, 8) 'Feuil2 est le CodeName de la feuille "ville"
  If .Rows.Count > 1 Then .Offset(1).Resize(.Rows.Count - 1, 1).Name = "Nom" 'plage nommée
  a = .Value 'matrice, plus rapide
End With
If Target.Address = "$A$2" Then
  Target.Select
  If Target <> "" Then
    cible = LCase(Trim(Target)) & "*" 'recherche sur le début du nom
    For i = 2 To UBound(a)
      If LCase(Trim(a(i, 1))) Like cible Then
        n = n + 1
        ReDim Preserve b(1 To 6, 1 To n) 'tableau transposé
        b(1, n) = a(i, 1)
        b(2, n) = a(i, 3)
        b(3, n) = a(i, 5)
        b(4, n) = a(i, 6)
        b(5, n) = a(i, 7)
        b(6, n) = a(i, 8)
      End If
    Next
    If n Then Target.Resize(n, 6) = Application.Transpose(b) 'restitution (Transpose suppose un maximum de 65536 lignes)
  End If
  Range("A" & n + 2 & ":F" & Rows.Count) = "" 'RAZ en dessous du tableau
End If
With [A1].CurrentRegion
  If .Rows.Count > 1 Then [A2].Resize(.Rows.Count - 1).Name = "Nom" 'nouvelle plage nommée
End With
End Sub

Nota : les espaces en début des noms sont supprimés par Trim et avec LCase la casse est ignorée.

En utilisant des tableaux VBA l'exécution est très rapide.

A+

 

[job75]

Re,

Comme je l'ai dit les espaces devant les noms des villes en 2ème feuille ne sont absolument pas gênants.

Mais il faut être cohérent : ou bien on n'en met pas ou bien il en faut un devant tous les noms.

Cette petite macro en met un devant tous les noms et trie la 2ème feuille :

Sub Espace_Tri()
Dim a, i&
With Feuil2.[A1].CurrentRegion.Resize(, 2) 'au moins 2 éléments
  a = .Value 'matrice, plus rapide
  For i = 2 To UBound(a)
    a(i, 1) = " " & Trim(a(i, 1)) 'espace devant le nom
  Next
  .Columns(1) = a
  .EntireRow.Sort .Columns(1), xlAscending, Header:=xlYes 'tri
End With
End Sub

@ Caillou : en effet une liste de validation est limitée à 32767 éléments...

A+

 

[JBARBE]

Re,
En cliquant sur le bouton GO
J'ai résolu le problème grâce à Job75 et à Caillou !
Merci beaucoup et bonne soirée !

 

[job75]

Re,

Avec une ComboBox comme l'a suggéré Caillou mais c'est assez compliqué :

Dim flag As Boolean 'mémorise la variable

Private Sub Worksheet_Change(ByVal Target As Range)
flag = True
With [A1].CurrentRegion
  If .Rows.Count > 1 Then
    ComboBox1.List = [A2].Resize(.Rows.Count - 1, 2).Value 'au moins 2 éléments
  Else
    With Feuil2.[A1].CurrentRegion 'Feuil2 est le CodeName de la feuille "ville"
      If .Rows.Count > 1 Then ComboBox1.List = .Offset(1).Resize(.Rows.Count - 1, 2).Value
    End With
  End If
End With
flag = False
End Sub

Private Sub ComboBox1_GotFocus()
Worksheet_Change ActiveCell 'pour définir la liste
End Sub

Private Sub ComboBox1_Change()
If flag Then Exit Sub 'bloque l'exécution
Dim a, cible$, i&, n&, b()
a = Feuil2.[A1].CurrentRegion.Resize(, 8) 'Feuil2 est le CodeName de la feuille "ville"
If Trim(ComboBox1) <> "" Then
  cible = LCase(Trim(ComboBox1)) & "*" 'recherche sur le début du nom
  For i = 2 To UBound(a)
    If LCase(Trim(a(i, 1))) Like cible Then
      n = n + 1
      ReDim Preserve b(1 To 6, 1 To n) 'tableau transposé
      b(1, n) = a(i, 1)
      b(2, n) = a(i, 3)
      b(3, n) = a(i, 5)
      b(4, n) = a(i, 6)
      b(5, n) = a(i, 7)
      b(6, n) = a(i, 8)
    End If
  Next
  If n Then [A2].Resize(n, 6) = Application.Transpose(b) 'restitution (Transpose suppose un maximum de 65536 lignes)
End If
Range("A" & n + 2 & ":F" & Rows.Count) = "" 'RAZ en dessous du tableau
End Sub

Fichier (2).

A+

 

[JBARBE]

Re,
J'ai bien essayé de mettre la comboBox suggéré par Caillou dans la feuille, mais je me suis abstenu compte tenu de la tâche ardu qui se présentait!
Bravo Job75 et encore une fois merci !
Je vais pouvoir proposer ce fichier dans ce post :
https://www.excel-downloads.com/threads/les-communes-de-france.20015393/
Bonne soirée !

 

[job75]

Bonjour JBARBE, Caillou, le forum,

J'ai un peu amélioré le code :

- Option Compare Text mieux que les LCase pour ignorer la casse

- si la 1ère feuille est filtrée il faut d'abord tout afficher

- l'entrée d'un espace dans la ComboBox affiche toutes les villes

- la macro ComboBox1_Change est plus rapide car le tableau b a été revu

- actualisation de la barre de défilement.

Option Compare Text 'la casse est ignorée
Dim flag As Boolean 'mémorise la variable

Private Sub Worksheet_Change(ByVal Target As Range)
flag = True
With [A1].CurrentRegion
  If .Rows.Count > 1 Then
    ComboBox1.List = [A2].Resize(.Rows.Count - 1, 2).Value 'au moins 2 éléments
  Else
    With Feuil2.[A1].CurrentRegion 'Feuil2 est le CodeName de la feuille "Ville"
      If .Rows.Count > 1 Then ComboBox1.List = .Offset(1).Resize(.Rows.Count - 1, 2).Value
    End With
  End If
End With
flag = False
End Sub

Private Sub ComboBox1_GotFocus()
Worksheet_Change ActiveCell 'pour définir la liste
End Sub

Private Sub ComboBox1_Change()
If flag Then Exit Sub 'bloque l'exécution
Dim cible$, a, b(), i&, n&
If Me.FilterMode Then Me.ShowAllData 'si la feuille est filtrée
If ComboBox1 <> "" Then
  cible = Trim(ComboBox1) & "*" 'recherche sur le début du nom
  a = Feuil2.[A1].CurrentRegion.Resize(, 8) 'Feuil2 est le CodeName de la feuille "Ville"
  ReDim b(1 To UBound(a), 1 To 6)
  For i = 2 To UBound(a)
    If Trim(a(i, 1)) Like cible Then
      n = n + 1
      b(n, 1) = a(i, 1)
      b(n, 2) = a(i, 3)
      b(n, 3) = a(i, 5)
      b(n, 4) = a(i, 6)
      b(n, 5) = a(i, 7)
      b(n, 6) = a(i, 8)
    End If
  Next
  If n Then [A2].Resize(n, 6) = b 'restitution
End If
Range("A" & n + 2 & ":F" & Rows.Count) = "" 'RAZ en dessous du tableau
With Me.UsedRange: End With 'actualise la barre de défilement verticale
End Sub

Fichier (3).

Bonne journée.