Comment accélérer mon code ?

[nak]

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.

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

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 Sub

Comment faire pour l'accélérer ? En sachant que le problème vient de la partie suppression.

Merci

 

[Habitude]

Re : Comment accélérer mon code ?

Bonjour à tous

Voila pour la requête évitant la suppression.


N.b, SQL ne gère pas les espaces dans les noms de champs. Dans le fichier base, j'ai remplacé Donnée 2 par Donnée_2

 

[nak]

Re : Comment accélérer mon code ?

Bonsoir à tous,

Habitude, je te remercie pour se code.

Voici les résultats suite à mes test :

Solution 1 - Importer l'ensemble de la base puis supprimer les lignes inutiles :
Cette solution se montre plus rapide lorsque l'on importe beaucoup de lignes (plus de 500). Dans tout les cas la durée de cette routine est toujours similaire.

Solution 2 - Importer uniquement le besoin (code Habitude):
Cette solution est très très rapide (presque instantanée) lorsque l'on importe peut de ligne. En revanche, si on veut importer beaucoup de ligne, la première solution est un bon choix.

Merci à tous pour votre participation.

A+

 

[laurent950]

Re : Comment accélérer mon code ?

Bonsoir,

Peut être une solution encore plus rapide, vous avez- une base en zip de + de 65536 lignes ? pour un test

j'ai refait le code, le temps est diviser par deux par rapport au poste #14

Sub test()

x = Timer
Application.ScreenUpdating = False
Dim F1 As Worksheet
Set F1 = ThisWorkbook.Worksheets("Feuil1")

' Valeur chercher F4 (Cellule)
Dim val As String
val = LCase(F1.Cells(4, 6))

' Redimension du tableau
Dim tabVal()
ReDim tabVal(1 To F1.Cells(65536, 1).End(xlUp).Row - 9, 1 To 20)

' Tableau excel en mémoire
Dim Mtab As Range
Set Mtab = F1.Range(F1.Cells(10, 1), F1.Cells(65536, 19).End(xlUp))

Dim cpt As Double
' Traitement des données (Filtre sur la colonne 2 du tableau avec critére
' en Cellule F4
For i = 1 To UBound(tabVal, 1)
    If Mtab(i, 2) = val Then
        cpt = cpt + 1
            For j = 1 To UBound(tabVal, 2)
                tabVal(cpt, j) = Mtab(i, j)
            Next j
    End If
Next i

' Suppression des données
F1.Range(F1.Cells(10, 1), F1.Cells(65536, 19).End(xlUp)).Clear

F1.Cells(10, 1).Resize(cpt, UBound(tabVal, 2)).Value = tabVal

Erase tabVal
Set Mtab = Nothing
cpt = Empty

Application.ScreenUpdating = True
MsgBox Timer - x
End Sub

laurent

 

[nak]

Re : Comment accélérer mon code ?

Bonjour à tous

Voila pour la requête évitant la suppression.


N.b, SQL ne gère pas les espaces dans les noms de champs. Dans le fichier base, j'ai remplacé Donnée 2 par Donnée_2

Bonjour,

J'ai adapté le code pour un nouveau fichier. Il a même fonctionné.
Sauf que depuis que j'ai touché d'autre fonction de mon fichier ça ne fonctionne plus !

J'ai tout vérifié, il me demande des variables, j'ai donc modifié le code :

Sub ChargerDonnees()
Dim Donnee As String, Source As String
    Application.ScreenUpdating = False: Range("A20").Resize(Range("A" & 2 ^ 20).End(xlUp).Row, 24).ClearContents
    Donnee = Range("O6").Value: Set Source = New ADODB.Connection
    Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "O:\Gestion.ard\PRODUC\@Méthodes\Ressources\Fiche_intervention\Base_FI.xls" & ";Extended Properties=""Excel 8.0;HDR=Yes;"";"
    Range("A20").CopyFromRecordset Source.Execute("SELECT * FROM [BaseFI$] WHERE Numéro_OF= '" & Donnee & "'")
    Source.Close
    Set Source = Nothing
    Application.ScreenUpdating = True
End Sub

Sauf que maintenant il me sort une erreur de compilation avec Objet requis. Pourtant les références sont activées...

Une idée ?

Merci

A+

 

[Habitude]

Re : Comment accélérer mon code ?

Bonjour

Source As String

Tu tente de faire un Open sur un String

essaie : Source as Object

 

[nak]

Re : Comment accélérer mon code ?

Tout de suite ça fonctione bien mieux... La honte...

Merci

Bonne soirée

 

[Staple1600]

Re : Comment accélérer mon code ?

Bonjour à tous

nak
Donc finalement ai-je bien fait de me turlupiner l'autre nuit à minuit trente et une ?

Pourquoi ne pas extraire directement uniquement les valeurs souhaitées et ce directement dans ta requête SQL?

Quelle solution as-tu finalement retenu?

As-tu encore besoin de supprimer des lignes?

PS: Merci à Habitude d'avoir apporté son expertise de SQL dans le fil
(Un jour, ou plutôt une nuit, il faudra que je m'y mette au SQL , dommage qu'on ne l'utilise pas au taf)

 

[nak]

Re : Comment accélérer mon code ?

Bonjour à tous,

Tout à fait Staple, tu as très bien fait de te turlupiner car c'est bien la solution SQL que j'ai retenue pour mon projet.

Je rassure tout de suite René et les autres, le code de suppression vitesse grand V va également me servir pour une autre fonction (indicateur).

Je vous remercie tous !

A+ sur le fofo

PS : Même à tout de suite...

 

[laetitia90]

Re : Comment accélérer mon code ?

bonjour tous

et si on boucler directement sur le fichier base pour exemple
dans l'exemple je l'ouvre rempli mon "tablo" puis le ferme a la fin du traitement
le fichier base .xls je l'ai mis sur le bureau a adapter
maitrise pas assez ADO comme l'ami Habitude pour partir sur un fichier fermé