Rappidité d'execution

[Franck]

Bonsoir le Forum et bonsoir a tous

Voila ! j'ai un USF qui fait une recherche dans une BD (Villes et code postale ) le probleme est que la BD fait environ 39000 lignes et donc la recherche est tres longue alors si quelqu'un a une idée ...
je l'en remercie d'avance

le fichier ne passe pas alors je vous confie le code

Private Sub TextBox1_Change()
Dim der As String
Dim pol As String
Dim cell As Range
Dim N As String
Dim MyString As String
'---------------------------------
DoEvents 'pour laisser la recherche se terminer en cas de saisie rapide

If TextBox1.Text = '' Then
Exit Sub
Else
MyString = String(1, TextBox1.Text) 'revoi le 1er cacactere du textbox1
End If

N = 0 'compteur

pol = Len(TextBox1) 'renvoi le nombre de caractere du textbox1
'----------------------------------
'On pre defini la selection pour accelerer la recherche
If MyString = ('A') Then Range('a2:a2034').Activate
If MyString = ('B') Then Range('a2035:a5528').Activate
If MyString = ('C') Then Range('a5529:a9618').Activate
If MyString = ('D') Then Range('a9619:a10427').Activate
If MyString = ('E') Then Range('a10428:a11351').Activate
If MyString = ('F') Then Range('a11352:a12623').Activate
If MyString = ('G') Then Range('a12624:a13963').Activate
If MyString = ('H') Then Range('a13964:a14703').Activate
If MyString = ('I') Then Range('a14704:a14925').Activate
If MyString = ('J') Then Range('a14926:a15280').Activate
If MyString = ('K') Then Range('a15281:a15376').Activate
If MyString = ('L') Then Range('a15377:a20353').Activate
If MyString = ('M') Then Range('a20354:a23847').Activate
If MyString = ('N') Then Range('a23848:a24654').Activate
If MyString = ('O') Then Range('a24655:a25239').Activate
If MyString = ('P') Then Range('a25240:a27262').Activate
If MyString = ('Q') Then Range('a27263:a27398').Activate
If MyString = ('R') Then Range('a27399:a28718').Activate
If MyString = ('S') Then Range('a28719:a34997').Activate
If MyString = ('T') Then Range('a34998:a36219').Activate
If MyString = ('U') Then Range('a36220:a36348').Activate
If MyString = ('V') Then Range('a36349:a38609').Activate
If MyString = ('W') Then Range('a38610:a38825').Activate
If MyString = ('X') Then Range('a38826:a38846').Activate
If MyString = ('Y') Then Range('a38847:a38911').Activate
If MyString = ('Z') Then Range('a38912:a38950').Activate
'---------------------------------
ListBox1.Clear
'Recherche
DoEvents
For Each cell In Selection
der = Left(cell.Value, pol)
If der = TextBox1.Value Then
ListBox1.AddItem cell.Offset(0, 0).Text, N 'afficher la colone 1
ListBox1.list(N, 2) = cell.Offset(0, 1).Text 'afficher la colone 2
ListBox1.list(N, 3) = cell.Offset(0, 2).Text 'afficher la colone 3
N = N + 1 'incrementer le compteur
End If
Next cell

End Sub

J'ai essayé la recherche avec Find ça rame autant -
Franck

 

[michel_m]

Bonsoir,

petites questions préalables:

1/ sur la ligne 1 as tu des étiquettes comme ville code postal,? si oui, communiques les nous ou mieux envoie un fichier avec 3 ou 4 lignes de ta base

2/ ce que tu cherches est bien de trouver un code postal à partir d'un nom de ville ?


La solution serait de laisser ta base fermée et d'utiliser ADO-SQL : le résultat sera pratiquement instantané.

Dans l'attente

 

[Franck]

Bonsoir Michel

Merci de t'attarder sur cette affaire
Voici un échantillon de ma BD

Commune Code postale Département
AAST 64460 PYRENEES ATLANTIQUES
ABAINVILLE 55130 MEUSE
ABANCOUR 59265 NORD
ABANCOURT 60220 OISE
ABAUCOURT 54610 MEURTHE ET MOSELLE

J’ai un Textbox1 dans lequel je saisi la ville que je recherche
A mesure que je saisi il me renvoi dans un listbox toutes les communes qui commence par ma saisie et dans la colonne d'a coté le code postale
Donc la liste se réduit a chaque fois que je tape une lettre
Pour finir je sélectionnerai la ville qui m'intéresse dans le listbox

J'ai également un textbox2 dans lequel je saisi le code postale et qui opère de la même façon pour retrouver la ou les communes


Pour ADO-SQL je ne connais pas si tu peus m'en dire un peu plus

Merci

 

[michel_m]

Bonjour,

Je n'aurai pas beaucoup de temps aujourd'hui, je regarderai ce soir ou le WE (vu la météo, je ne bougerai pas de la tanière) si d'ici là sd'autre forumeurs (salut mon cher Michel XLD) n'ont pas traité le pb

A+
Michel

 

[Bricofire]

Bonjour le fil,michel_m, Frank

Au risque de me planter, mais ta réponse Frank et ta description de ton textbox me fait penser à ce que fait tout seul un Combobox multicolonne avec sa propiété MatchEntry à 1 (fmMatchEntryComplete). Pour le multicolonne tu mets ColumnCount à ce que tu veux, pour la colonne qui récupère la valeur tu l'indiques dans BoundColumn.

J'ai peu de temps ce matin, mais si tu sais faire une listbox, c'est à la base pareil, sinon tu cliques su la propriété et tu appuies sur F1, l'aide est bien documentée là-dessus...

Bon courage

Bfr

 

[Franck]

Bonsoir Bricofire et Michel

Je fais peut etre erreure a mon tour mais il me semble que le combobox avec propriete MatchEntry à 1 (fmMatchEntryComplete) ne réagit pas exactement de la meme façon que mon listbox

Private Sub UserForm_Initialize()
Windows('BD texte.xls').Activate
Sheets('Adresse').Activate
ComboBox1.MatchEntry = 1
ComboBox1.RowSource = ('a:a')
End Sub

Dans le combobox je saisi la lettre A il me trouve la ville AAST
c'est tres bien mais mon listbox lui me sort toutes les communes commançant par A ce qui fait que au bout de 3 ou 4 lettres je tiens ma communes (ou mes communes qui portent le meme nom mais qui n'ont pas le meme CP) c'est pourquoi j'ai egalement crée une 3eme colonne ou s'affichent les départements


Merci et a +

 

[Hervé]

Bonjour franck, michel, brico, le forum, la terre


Peut etre en passant par des tableaux dynamiques :

Option Compare Text 'permet de s'affranchir de la casse
Private Sub TextBox1_Change()
Dim tablo As Variant
Dim tablores() As String
Dim i As Long, x As Long
Dim j As Byte

If TextBox1 = '' Then Exit Sub
tablo = Range('a2').CurrentRegion

For i = 1 To UBound(tablo)
        If Left(tablo(i, 1), Len(TextBox1)) = TextBox1 Then
                x = x + 1
                ReDim Preserve tablores(1 To 3, 1 To x)
                For j = 1 To UBound(tablo, 2)
                        tablores(j, x) = tablo(i, j)
                Next j
        End If
Next i
ListBox1.Column = tablores

End Sub

salut

 

[Franck]

Merci Herve pour ton aide qui est ..(comme d'habitude)

Apres un petit test ça semble tres rappide - mais j'ai un probleme quand je saisi une lettre qui na pas de correspondance j'ai un message d'erreur 'impossible dee définir la propriete Column' Pour le code ListBox1.Column = tablores
Aurais tu une idée pour lui donner une valeur par défaut ou prédefinie
puisque apres tout il me faut 3 colonnes
Et si l'entrée ne correspond a rien le textbox1 peut rester vierge

... Franck

 

[Hervé]

re tout le monde

J'ai jamais trouvé de solution parfaite pour tester si un tableau dynamique etait vide. Je passe donc par un boolean pour ceci.

Option Compare Text 'permet de s'affranchir de la casse
Private Sub TextBox1_Change()
Dim tablo As Variant
Dim tablores() As String
Dim i As Long, x As Long
Dim j As Byte
Dim trouver As Boolean

trouver = False

If TextBox1 = '' Then
        ListBox1.Clear
        Exit Sub
End If

tablo = Range('a2').CurrentRegion

For i = 1 To UBound(tablo)
        If Left(tablo(i, 1), Len(TextBox1)) = TextBox1 Then
                x = x + 1
                trouver = True
                ReDim Preserve tablores(1 To 3, 1 To x)
                For j = 1 To UBound(tablo, 2)
                        tablores(j, x) = tablo(i, j)
                Next j
        End If
Next i

If trouver Then
        ListBox1.Column = tablores
Else
        MsgBox 'pas de correpondance.'
        TextBox1 = ''
End If


End Sub

salut

 

[Franck]

Re re...

Moi javais trouvé ça entre temps

Dim tablo As Variant
Dim tablores() As String
Dim i As Long, x As Long
Dim j As Byte

If TextBox1 = '' Then Exit Sub
tablo = Range('a2').CurrentRegion

For i = 1 To UBound(tablo)
If Left(tablo(i, 1), Len(TextBox1)) = TextBox1 Then
x = x + 1
ReDim Preserve tablores(1 To 3, 1 To x)
For j = 1 To UBound(tablo, 2)
tablores(j, x) = tablo(i, j)
Next j
End If
Next i
On Error Resume Next
ListBox1.Column = tablores


Je suis pas sur que se soit tres clean mais ça marche
Ton avis?



Merci Franck

 

[Hervé]

re tout le monde

Franck, j'ai pas vraiment d'avis, le principale c'est que ca fonctionne comme tu le veux

Mais, je suis pas très fan des gestionnaires d'erreur pour gérer ce type de problème quant une autre solution est envisageable.


Ah ben si, au final j'ai un avis

Faudrait que les pros du forum nous éclairent sur ce type de procédure : on error ou boolean ?

à suivre peut etre.

salut

 

[Charly2]

Bonsoir le fil, bonsoir Franck et Hervé, bonsoir la Terre, bonsoir l'Univers

Ben... Euh... Sans être un pro du forum, ai-je le droit de donner mon avis ???

Bon d'accord, je le donne à la demande générale de moi-même Personnellement, en tant qu'ex-analyste-programmeur, j'aime pas trop les gestions d'erreur, ni les Exit Sub ou les Exit For et j'en oublie...

Enfin, tout ça pour dire que je préfère, et de loin, la solution d'Hervé qui consiste à passer par un Boolean :whistle:

C'était mon édifice à la pierre

A+
Charly

 

[Zon]

Salut,


Il me semble qu'il n'y a pas besoin de booléen ou de gestion d'erreur , x le fait déjà dans le cas présent

...
Next i
if x>0 then ListBox1.Column = tablores


A+++

 

[Franck]

Bonjours a tous

Finalement je suis assez d'accord avec Zon avec encore une petite modif

If x > 0 Then
ListBox1.Column = tablores
Else
ListBox1.Clear
End If

et la tout est parfait

Merci a tous les participants de ce fil que je ne manquerai pas de surveiller

Franck

 

[Bricofire]

Bonsoir tout le monde, Frank

Bon , pour ce qu est du ComboBox, (avec bien sur RowSource lié aux 4 colonnes…. ) si on frappe une lettre (ou chiffre), on a les occurrences correspondantes, si on en frappe 2, ça filtre plus, 3 etc…
Bien sur pour voir la « Liste », il faut cliquer sur la flèche à droite de la fenêtre qui t’affiche alors le nombre de lignes que tu as défini via ListRows…

Avec TextColumn tu indiques la colonne qui affiche la selection (recherche)

Dans le fichier joint, j’avais 58000 codes barres (chers à Dan ) avec 4 colonnes, tu as deux combos identiques mais réglés sur les colonnes 1 ou2. l’affichage est instantané chez moi et j’ai bien sûr les doublons dans la liste déroulante. On récupère les donnée de la sélection facilement en vba. Avec ColumnHeads à true tu as même les entêtes de colonnes fixes dans ta liste de choix !. C’est brut de fonderie, donc on lance le combo via vba et les données ont été ramenées au nb de lignes pour un zip OK.

juste pour le fun

Bon WE,
Bfr [file name=CpBelges2.zip size=46651]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/CpBelges2.zip[/file]