[VBA ADO ] Ado + excel

**Deejoh** · 26/01/2006, 15h39

Bonjour à tous,

voilà dans un classeur excel je dois importer tous les enregistrements ayant en colonne 46=IN et en colonne 47 = N . Ces enregistrement sont répartis sur 2 feuilles nommée A et B .

J'ai donc réalisé une procédure sans ADO mais il s'avère que sur 50000 enregistrements c'est trés lent...

J'aimerai donc savoir comment je peux faire en utilisant ADO ?

Merci d'avance

**Megaxel** · 26/01/2006, 15h43

Je ne sais pas comment tu fais sans ADO, mais vu la simplicité de ta recherche, même sur 50000 lignes, ça m'étonne que ce soit si lent que ça.
Tu ne veux pas nous montrer ta méthode actuelle?

**Deejoh** · 26/01/2006, 15h49

Pas de problème la voilà :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 
 
Private Sub Triage(NomFeuille As String)
 
Dim TopDebrayeN As String
Dim TopRQIN As String
Dim Test As Integer
 
i = 3
TopDebrayeN = "N"
TopRQIN = "IN"
 
Workbooks(ClasseurEMI).Sheets(NomFeuille).Activate
 
Do While Not IsEmpty(Cells(i, 1)) Or i = 65536
    Test = 0
    TestDebraye = InStr(Cells(i, 47), TopDebrayeN)
    TestTopRQ = InStr(Cells(i, 46), TopRQIN)
 
    If TestDebraye <> 0 And TestTopRQ <> 0 Then
 
        'Procédure de copie du classeur ARRIERE EMI vers le classeur OUTIL HD
        ProcCopie i, NomFeuille, OuColler
        OuColler = OuColler + 1
 
    End If
 
    i = i + 1
 
Loop
 
End Sub

ProcCopie est ici :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
 
Public Sub ProcCopie(LigneEnCours As Long, NomFeuille As String, LigneOuColler As Long)
 
'Selection + copie de la ligne concernée
Rows(LigneEnCours).Select
Selection.Copy
 
'Activation du classeur OutilHD + collage de la ligne copiée dans la feuille A
ThisWorkbook.Worksheets(FeuilleA).Activate
Rows(LigneOuColler).Select
ActiveSheet.Paste
 
'Activation du classeur Arriere EMI afin de continuer la recherche
Workbooks(ClasseurEMI).Worksheets(NomFeuille).Activate
 
End Sub

**Pierre Fauconnier** · 26/01/2006, 16h02

Bonjour

Tu pourrais essayer avec un filtre automatique

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
 
Sub Test()
    With Range("a1")
        .AutoFilter
        .AutoFilter field:=2, Criteria1:="IN"
        .AutoFilter field:=3, Criteria1:="N"
        Range("a3:c" & Range("a65536").End(xlUp).Row).Copy _
            Destination:=Feuil2.Range("a2")
        .AutoFilter
    End With
End Sub

Ceci est un exemple qu'il faut adapter à ton cas, notamment pour les n°s des colonnes servant à identifier les IN et les N.
L'idée est de placer un filtre automatique en spécifiant les champs servant au filtre, puis d'effectuer un copie-coller.

Ok?

Pierre Fauconnier

**Megaxel** · 26/01/2006, 16h07

Je pense que la méthode de Pierre doit accélerer beaucoup les choses, mais pour en revenir à ton code, il n'y a rien de pire pour la lenteur d'exécution que les SELECT, COPY, PASTE, ACTIVATE....
Rien que les rafraîchissements d'écran, c'est horrible.
Juste en rajoutant "ScreenUpdating = False", tu gagneras pas mal.
PS: Je ne suis pas sûr du ScreenUpdating... Mais c'est un truc qui ressemble à ça.

**Deejoh** · 26/01/2006, 16h11

en fait j'ai un Main qui s'occuppe de lancer cette procédure et il a un apllication.Screenupdating=False

J'ai déjà utilisé les filtre mais c'est pas une méthode que je trouve trés fiable.

Personne pour m'éclairer sur l'ADO avec excel ???

**bouley** · 26/01/2006, 16h35

salut Deejoh,

Voici de l'ADO pour se connecter à un fichier Excel Fermé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 
Sub ExempleConnectionFichierExcelFerme()
'La référence à Microsoft ActiveX Data Objects 2.X Library doit être cochée
'dans menu Outils -----Références
'Le fichier Excel s'appelle Client.xls
' Pour [nom de la feuille$] on ecrit le nom de la feuille sans ""
' Pour Feuil1 ----> [Feuil1$]
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
 
   'Connection au fichier Excel
    cn.Provider = "MSDASQL"
    cn.ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};DBQ=C:\clients.xls; "
    cn.Open
 
   'Requete
    sql1 = "SELECT *  FROM [nom de la feuille$]"
   'Connection du recordset
    rs.Open sql1, cn
 
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

Teste et tiens nous au courant !
Mais je pense fermement que le traitement par un filtre automatique ou élaboré reste la solution la plus rapide.

@+

**SilkyRoad** · 26/01/2006, 18h47

bonjour

ci joint un réponse similaire à celle de Bouley .
il te restera à adapter nomColonne46 , nomColonne47 et le nom des feuilles

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Private Sub CommandButton1_Click()
Dim Conn As ADODB.Connection
Dim rsT As ADODB.Recordset
Dim Fichier As String, Direction As String, rSQL As String
 
Direction = ThisWorkbook.Path
Fichier = "maBase.xls"
 
    Set Conn = New ADODB.Connection
    With Conn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Data Source=" & Direction & "\" & Fichier & _
    ";Extended Properties=Excel 8.0;"
    .Open
    End With
 
    rSQL = "SELECT * FROM [Feuil1$] WHERE [nomColonne46] ='IN' AND [nomColonne47] ='N'"
 
    Set rsT = New ADODB.Recordset
    With rsT
    .ActiveConnection = Conn
    .Open rSQL, , adOpenKeyset, adLockOptimistic, adCmdTableDirect
    End With
 
    Range("A1").CopyFromRecordset rsT
    rsT.Close
    Conn.Close
 
End Sub

bonne soiree
michel

**Deejoh** · 26/01/2006, 18h49

GENIAL MERCI BEAUCOUP A VOUS TOUS JE TESTE CA DES DEMAIN

**random** · 26/01/2006, 19h50

compte tenu du type de pb traité et des volumes le mieux serait de passer
à access

**Deejoh** · 27/01/2006, 10h53

ça marche presque...
j'ai une erreur au niveau du :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
 
    With rsT
    .ActiveConnection = Conn
  ICI ==> .Open rSQL, Conn, adOpenDynamic, adLockOptimistic
    End With

J'ai comme message d'erreur : "Aucune valeur donnée pour un ou plusieur paramètre requis"

[/u]

**SilkyRoad** · 27/01/2006, 10h58

bonjour

qu'est ce que tu a saisi dans la procédure pour adapter cette ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 rSQL = "SELECT * FROM [Feuil1$] WHERE [nomColonne46] ='IN' AND [nomColonne47] ='N'"

bonne journée
michel

**Deejoh** · 27/01/2006, 11h05

Bonjour et merci

j'ai mis ça

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
 
 
 
Private Sub testAdo2()
 
Dim Conn As ADODB.Connection
Dim rsT As ADODB.Recordset
Dim Fichier As String, Direction As String, rSQL As String
 
Direction = ThisWorkbook.Path
Fichier = "ARRIEREEMI2.xls"
 
    Set Conn = New ADODB.Connection
    With Conn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Data Source=" & Direction & "\" & Fichier & _
    ";Extended Properties=Excel 8.0;"
    .Open
    End With
 
    rSQL = "SELECT * FROM [A$] WHERE [TOP] ='IN' AND [TOP2] ='N'"
 
    Set rsT = New ADODB.Recordset
 
 
    With rsT
    .ActiveConnection = Conn
    .Open rSQL, Conn, adOpenDynamic, adLockOptimistic
    End With
    ThisWorkbook.Worksheets("A").Activate
    Range("A1").CopyFromRecordset rsT
    rsT.Close
    Conn.Close
 
End Sub

**SilkyRoad** · 27/01/2006, 11h21

bonjour

je viens de tester ta macro tel quel et cela fonctionne tres bien chez moi (Excel2002 & WinXP)
les données filtrées sont bien importées ...

comment est structuré ton classeur fermé ? il y a des champs vides ? les entetes TOP et TOP2 sont sur la premiere ligne du classeur ? ...

bonne journée
michel

**Deejoh** · 27/01/2006, 11h29

Arf erreur bête

Y'avait des filtres en haut des colonnes

Merci BEAUCOUP Michel

**Megaxel** · 27/01/2006, 13h34

Veux-tu bien cliquer sur le bouton

en bas à gauche, s'il te plait? Ça évitera à d'autre que moi de relire tout le post pour comprendre de quoi il s'agit avant d'arriver au bout pour voir que tu as ta solution...

Merci.

[VBA ADO ] Ado + excel

Macros et VBA Excel

Discussions similaires

Partager

Partager