Bonjour,
Voici un code qui me permet de récupérer les données d'une base et d'ensuite supprimer les lignes de la base qui ne correspondent pas à mon filtre en F4.
Comment faire pour l'accélérer ? En sachant que le problème vient de la partie suppression.
Merci
Voici un code qui me permet de récupérer les données d'une base et d'ensuite supprimer les lignes de la base qui ne correspondent pas à mon filtre en F4.
VB:
Sub extractionValeurBase()
Dim Source As ADODB.Connection
Dim Rst As ADODB.Recordset
Dim ADOCommand As ADODB.Command
Dim Fichier As String, Cellule As String, Feuille As String
'Adresse de la cellule contenant la donnée à rechercher
Cellule = "A2:T"
Feuille = "Feuil1$" 'n'oubliez pas d'ajouter $ au nom de la feuille.
'Chemin complet du classeur fermé
Fichier = ThisWorkbook.Path & "\base.xls"
Set Source = New ADODB.Connection
Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier & ";Extended Properties=""Excel 8.0;HDR=No;"";"
Set ADOCommand = New ADODB.Command
With ADOCommand
.ActiveConnection = Source
.CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
End With
Set Rst = New ADODB.Recordset
Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
Set Rst = Source.Execute("[" & Feuille & Cellule & "]")
Range("A11").CopyFromRecordset Rst
Rst.Close
Source.Close
Set Source = Nothing
Set Rst = Nothing
Set ADOCommand = Nothing
Call supprimerOF
End Sub
VB:
Sub supprimerOF()
Dim i As Long, derligne As Long
derligne = Range("A65536").End(xlUp).Row
Application.ScreenUpdating = False
'Suppression des lignes inutiles
For i = derligne To 11 Step -1
If UCase(Range("B" & i).Value) <> UCase(Range("F4").Value) Then Rows(i).Delete
Next i
Application.ScreenUpdating = True
End SubComment faire pour l'accélérer ? En sachant que le problème vient de la partie suppression.
Merci
