Rappidité d'execution

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