XL 2016 Remplir Combobox vitesse grand v [RESOLU]

[Compte Supprimé 979]

Bonjour à toutes et à tous

Qui saura répondre à ma problématique...
J'ai un fichier ".xlsx" contenant les 36.000 communes françaises et leur code postal
J'aimerai à partir d'un autre fichier contenant un USF, venir alimenter les 2 colonnes de la combobox

Je pensais le faire via la méthode ADO, mais avec mon code, le remplissage est "long"

Private Sub UserForm_Activate()
  Dim sPathBdD As String, sTable As String, FlgErrCon As Boolean
  Dim sSQL As String, sField As String, IdField As Integer
  ' Initialiser les variables
  sTable = "Liste"
  sPathBdD = VParam("DossierBdD")
  If Right(sPathBdD, 1) <> "\" Then sPathBdD = sPathBdD & "\"
  sPathBdD = sPathBdD & "BdD Villes.xlsx"
  ' Tester si le fichier se trouve bien à l'endroit prévu
  If Not ExisteFichier(sPathBdD) Then
    sPathBdD = Application.GetOpenFilename(FileFilter:="BdD Villes (*.xls*), *.xls*", _
        Title:="Merci de sélectionner le fichier des viles")
  End If

  ' En cas d'erreur
  On Error GoTo Erreur_Proc
  ' Vider la combobox en question et initialiser la chaine de connexion
  If Me.Cbx_Choix.ListCount > 0 Then Me.Cbx_Choix.Clear
  FlgErrCon = False: sConn = ""
  ' Créer une nouvelle instance ADO
  Set Cnn = CreateObject("ADODB.Connection")
  ' Créer la connexion vers le fichier Excel
  With Cnn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
           & sPathBdD & ";Extended Properties=""Excel 12.0;HDR=YES;"""
    .Open
  End With
  ' En cas d'erreur message d'information à l'utilisateur
  If FlgErrCon = True Then
    MsgBox "Impossible de se connecter à la base de données !", vbCritical, "OUPS..."
    GoTo FermetureCnn
  End If
  ' Préparer la requête
  If InStr(1, sTable, " ") > 0 Then
    sSQL = "SELECT * FROM ['" & sTable & "$']"
  Else
    sSQL = "SELECT * FROM [" & sTable & "$]"
  End If
  ' Créer un nouveau Recordset et l'ouvrir
  Set Rs = CreateObject("ADODB.Recordset")
  ' Avec le Recordset, récupérer les enregistrements
  With Rs
    ' Ouvrir le recordset
    .Open sSQL, Cnn, CursorType
    ' En cas d'erreur
    If FlgErrCon = True Then GoTo FermetureRs
    ' Sinon
    Do While Not .EOF
      Me.Cbx_Choix.AddItem Rs.Fields(0)
      Me.Cbx_Choix.List(Me.Cbx_Choix.ListCount - 1, 1) = Rs.Fields(1)
      ' Enregistrement suivant
      .MoveNext
    Loop
  End With
  ' Fermeture du Recordset
FermetureRs:
  Rs.Close
  Set Rs = Nothing

  ' Fermeture de la connexion
FermetureCnn:
  Cnn.Close: Set Cnn = Nothing
  On Error GoTo 0
  Me.Caption = "CHOIX de la VILLE du CHANTIER"
  Exit Sub

Erreur_Proc:
  FlgErrCon = True  ' Mettre le FLAG d'erreur de connexion à vrai
  Resume Next
End Sub

Qui saurait me raccourcir le temps d'exécution
Chose importante, je ne veux pas intégrer la liste des villes dans mon fichier principal.

A+

 

[chris]

Bonjour Bruno, le forum

Une combo de 36000 entrées est peu friendly.

Ne serait-il pas possible de prévoir un 1er filtre sur le CP ou le département afin d'introduire un WHERE et réduire les réponses ?

 

[Compte Supprimé 979]

Coucou Miss ravi de te croiser

Le problème, est qu'il s'agit de chantiers qui peuvent se faire n'importe où ou presque
Et donc l'utilisateur ne va pas savoir dans quel département la ville se trouve

Ceci dit le choix ne doit se faire qu'une fois et le temps d'affichage est < 3s

C'était au cas où....

A+

 

[VIARD]

Bonjour Bruno et à toutes et tous

Je te propose une réalisation, à toi de voir
A+

Jean-Paul

 

[Compte Supprimé 979]

Bonjour Nicole, Viard

Merci pour vos réponses, mais j'ai omis une chose importante que je pensais être explicite de part mon énoncé je ne veux pas intégrer la liste des villes dans mon fichier principal

A+

 

[Dranreb]

Bonjour.
Tout d'abord ton chargement est rapide chez moi.
Mais ceci peut être légèrement plus, avec 2 ComboBox, une pour la ville l'autre le code postal :

Option Explicit
Private WithEvents CL As ComboBoxLiées

Private Sub UserForm_Initialize()
Set CL = CBxL.Création.ComboBoxLiées
CL.Plage Workbooks("BdD Villes.xlsx").Worksheets("Liste").[A2:B2]
CL.Add CBxVille, 1
CL.Add CBxCodePostal, 2, "00000"
CL.Actualiser
End Sub
Private Sub CL_SujFltChg(ByVal CBM As CBxL.ComboBoxMmbr, ByVal Filtré As Boolean)
If Not CBM.CBx Is Me.ActiveControl Then Exit Sub
If Not CBM.CBx Is Me.CBxVille Then Exit Sub
If CBM.CBx.MatchFound Or CBM.CBx.Text = "" Then Exit Sub
Dim S ' Sujet temporaire pour recherche intuitive
S = CBxL.SujCBxLike(CBM.SujetFlt, "*" & CBM.CBx.Text & "*")
If IsEmpty(S) Then Exit Sub
CBM.SujetFlt = S ' Affectation du sujet temporaire.
CBM.CBx.DropDown ' Affichage de la liste
End Sub

 

[Compte Supprimé 979]

Salut l'ami

Tout d'abord ton chargement est rapide chez moi.

Perso moi aussi : 2,07 secondes, mais le challenge était de savoir si on pouvait encore l'accélérer

Comme dit précédemment, je ne veux pas mettre la liste des communes dans le même fichier (voir mes fichiers joints)
Je pensais pourvoir attribuer un "Recordset" à la propriété "List" de ma combobox, mais comme c'est sur 2 colonnes (impératif) je pense que ce n'est pas possible

Au plaisir

 

[mapomme]

Bonjour BrunoM45 , le forum ,

Une version qui ouvre le fichier, transfère les données puis le referme. C'est assez rapide.

 

[mapomme]

Re,

Houpsssss ! J'avais oublié le tri par ville .

C'est corrigé dans le fichier joint .

 

[Dranreb]

je ne veux pas mettre la liste des communes dans le même fichier (voir mes fichiers joints)

J'ai bien laissé la liste des communes séparée, dans son fichier.
Ça ne poserait pas de problème d'en ajouter l'ouverture si nécessaire devant le CL.Plage …

 

[gosselien]

Re,

Houpsssss ! J'avais oublié le tri par ville .

C'est corrigé dans le fichier joint .

0.29 seconde pour charger
WIN 10 DELL 4Ghz 24 Gg Ram Excel 2010

 

[Compte Supprimé 979]

YEEEEESSSS and the Winner is... Nicole

Avec ADO, il suffit d'alimenter le ComboBox par .Column

Private Sub UserForm_Initialize()
  Set cnn = New ADODB.Connection
  répertoire = ThisWorkbook.Path & "\"
  fichier = "BDCommunesCP.xls"
  cnn.Open "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=" & répertoire & fichier
  Set rs = cnn.Execute("[BD$A2:B36000]")
  Me.ComboVille.Column = rs.GetRows
  rs.Close
  cnn.Close
  Set rs = Nothing
  Set cnn = Nothing
End Sub

BISSON

Mais oui voilà... il faut mette dans les 2 colonnes les lignes du Recordset... mais c'est bien sur

Ultra super nickel... un GRAND MERCI

 

[mapomme]

Bonjour à tous ,

Une version V2 avec la recherche qui est opérationnelle.

On détecte automatiquement si on veut rechercher une commune ou un code postal.

Les codes postaux des départements 01 à 09 doivent être saisis avec le zéro en début de code postal.

nota : le temps de chargement est un poil plus long car je fais du traitement de texte des données pendant l’initialisation.

 

[gosselien]

YEEEEESSSS and the Winner is... Nicole

Suis pas étonné, Bisson donne toujours de bonnes réponses °_°

 

[Compte Supprimé 979]

Salut Gosselien

Suis pas étonné, Bisson donne toujours de bonnes réponses °_°

Oui tout à fait... parce que BISSON FUTÉ