[VBA ADO ] Ado + excel

Version imprimable

26/01/2006, 14h39
Deejoh

[VBA ADO ] Ado + excel

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
26/01/2006, 14h43
Megaxel

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?

Pas de problème la voilà :

Code:

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:

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

Bonjour

Tu pourrais essayer avec un filtre automatique
Code:

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

26/01/2006, 15h07
Megaxel

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.
26/01/2006, 15h11
Deejoh

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 ???

salut Deejoh,

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

Code:

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.

@+

bonjour

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

Code:

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

26/01/2006, 17h49
Deejoh

GENIAL MERCI BEAUCOUP A VOUS TOUS JE TESTE CA DES DEMAIN :)
26/01/2006, 18h50
random

compte tenu du type de pb traité et des volumes le mieux serait de passer
à access
27/01/2006, 09h53
Deejoh
ça marche presque...
j'ai une erreur au niveau du :
Code:

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" 8O 8O

[/u]
27/01/2006, 09h58
SilkyRoad

bonjour

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

Code:

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

bonne journée
michel

Bonjour et merci :)
j'ai mis ça

Code:

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

27/01/2006, 10h21
SilkyRoad

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
27/01/2006, 10h29
Deejoh

Arf erreur bête :P
Y'avait des filtres en haut des colonnes :P

Merci BEAUCOUP Michel :D :D :D
27/01/2006, 12h34
Megaxel

Veux-tu bien cliquer sur le bouton :resolu: 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... :roll:

Merci.