Boucle For bug ! help ! VBA !

B

Bill607

XLDnaute Nouveau
Bonjour à tous,

Je souhaite faire une statistique ( recenser ) certaines données depuis classeur excel fermé et la noter vers un classeur qui existe déjà.
Pour cela, j'établis ma connection qui marche PERFECTO :p ! Sauf que les lignes du classeur fermé étant de 2000, ma boucle bug (prends trop de temps ) quand je la fais tourner sur 20 ou 30 à peine ( mais ca marche pour <20 avec un temps d'attente de 1-2 min :confused:.

Voilà mon code :

Code: 
Function LitUneCellule(repertoire As String, fichier As String, feuille As String, i As Integer)
  Dim cellule As String
  cellule = "L" & i & ":L" & i
  Application.Volatile
  Set cnn = New ADODB.Connection
    '--- Connexion ---
    With cnn
        .Provider = "Microsoft.Jet.OLEDB.12.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
           & repertoire & "\" & fichier & ";Extended Properties=""Excel 12.0 Xml;HDR=NO;"""
       .Open
    End With
    '-----------------
Set rs = cnn.Execute("SELECT * FROM [" & feuille & "$" & cellule & "]")
  LitUneCellule = rs(0)
  rs.Close
  cnn.Close
  Set rs = Nothing
  Set cnn = Nothing
End Function
_______________________________________________________________________________________________

Sub Lit()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim i As Integer

    For i = 2 To 20
    
   
    ZB = LitUneCellule("S:\PARIS-VAT", "UNDUE_VAT_REPORT_TABLE_Macro1.xlsm", "Zuzana Bugarova", i)
    JP = LitUneCellule("S:\PARIS-VAT", "UNDUE_VAT_REPORT_TABLE_Macro1.xlsm", "Johanna PASDELOUP", i)
    SM = LitUneCellule("S:\PARIS-VAT", "UNDUE_VAT_REPORT_TABLE_Macro1.xlsm", "Siouzanna MAIGNAN", i)
    JM = LitUneCellule("S:\PARIS-VAT", "UNDUE_VAT_REPORT_TABLE_Macro1.xlsm", "John MINCHOM", i)
    BD = LitUneCellule("S:\PARIS-VAT", "UNDUE_VAT_REPORT_TABLE_Macro1.xlsm", "Beatrice DURGHEU", i)
    FI = LitUneCellule("S:\PARIS-VAT", "UNDUE_VAT_REPORT_TABLE_Macro1.xlsm", "Isabelle FUTIN", i)
    RV = LitUneCellule("S:\PARIS-VAT", "UNDUE_VAT_REPORT_TABLE_Macro1.xlsm", "Reka VEGVARI", i)
    AM = LitUneCellule("S:\PARIS-VAT", "UNDUE_VAT_REPORT_TABLE_Macro1.xlsm", "Agnieszka MIEDZIK", i)
    
    
        og = "Ongoing"
        dv = "Due VAT"
        oh = "On hold"
        cnR = "CN received"
        rjec = "Rejected"
        tbc = "To be contacted"
        
        Select Case cnR
            Case ZB, JP, SM, JM, BD, FI, RV, AM
                g = g + 1
        End Select
        Select Case dv
            Case ZB, JP, SM, JM, BD, FI, RV, AM
                e = e + 1
        End Select
        Select Case oh
            Case ZB, JP, SM, JM, BD, FI, RV, AM
                f = f + 1
        End Select
        Select Case og
            Case ZB, JP, SM, JM, BD, FI, RV, AM
                k = k + 1
        End Select
        Select Case rjec
            Case ZB, JP, SM, JM, BD, FI, RV, AM
                h = h + 1
        End Select
        Select Case tbc
            Case ZB, JP, SM, JM, BD, FI, RV, AM
                j = j + 1
        End Select
       
 Next
 
 Cells(18, 3) = g
 Cells(19, 3) = e
 Cells(20, 3) = f
 Cells(21, 3) = k
 Cells(22, 3) = h
 Cells(23, 3) = j

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Merci beaucoup pour votre aide qui m'aidera énormément !!!!!!!!! :eek: ;)
 
Trier par date Trier par votes
fhoest

fhoest

XLDnaute Accro
Re : Boucle For bug ! help ! VBA !

Bonjour,
à tout hazard avec un Doevents
Code: 
Function LitUneCellule(repertoire As String, fichier As String, feuille As String, i As Integer)
   Dim cellule As String
   cellule = "L" & i & ":L" & i
   Application.Volatile
   Set cnn = New ADODB.Connection
     '--- Connexion ---
     With cnn
         .Provider = "Microsoft.Jet.OLEDB.12.0"
         .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & repertoire & "\" & fichier & ";Extended Properties=""Excel 12.0 Xml;HDR=NO;"""
        .Open
     End With
     '-----------------
 Set rs = cnn.Execute("SELECT * FROM [" & feuille & "$" & cellule & "]")
   LitUneCellule = rs(0)
   rs.Close
   cnn.Close
   Set rs = Nothing
   Set cnn = Nothing
 End Function
 _______________________________________________________________________________________________

 Sub Lit()
 Application.Calculation = xlCalculationManual
 Application.ScreenUpdating = False
 Dim i As Integer
     For i = 2 To 20
     DoEvents
    
     ZB = LitUneCellule("S:\PARIS-VAT", "UNDUE_VAT_REPORT_TABLE_Macro1.xlsm", "Zuzana Bugarova", i)
     JP = LitUneCellule("S:\PARIS-VAT", "UNDUE_VAT_REPORT_TABLE_Macro1.xlsm", "Johanna PASDELOUP", i)
     SM = LitUneCellule("S:\PARIS-VAT", "UNDUE_VAT_REPORT_TABLE_Macro1.xlsm", "Siouzanna MAIGNAN", i)
     JM = LitUneCellule("S:\PARIS-VAT", "UNDUE_VAT_REPORT_TABLE_Macro1.xlsm", "John MINCHOM", i)
     BD = LitUneCellule("S:\PARIS-VAT", "UNDUE_VAT_REPORT_TABLE_Macro1.xlsm", "Beatrice DURGHEU", i)
     FI = LitUneCellule("S:\PARIS-VAT", "UNDUE_VAT_REPORT_TABLE_Macro1.xlsm", "Isabelle FUTIN", i)
     RV = LitUneCellule("S:\PARIS-VAT", "UNDUE_VAT_REPORT_TABLE_Macro1.xlsm", "Reka VEGVARI", i)
     AM = LitUneCellule("S:\PARIS-VAT", "UNDUE_VAT_REPORT_TABLE_Macro1.xlsm", "Agnieszka MIEDZIK", i)
     
     
         og = "Ongoing"
         dv = "Due VAT"
         oh = "On hold"
         cnR = "CN received"
         rjec = "Rejected"
         tbc = "To be contacted"
         
         Select Case cnR
             Case ZB, JP, SM, JM, BD, FI, RV, AM
                 g = g + 1
         End Select
         Select Case dv
             Case ZB, JP, SM, JM, BD, FI, RV, AM
                 e = e + 1
         End Select
         Select Case oh
             Case ZB, JP, SM, JM, BD, FI, RV, AM
                 f = f + 1
         End Select
         Select Case og
             Case ZB, JP, SM, JM, BD, FI, RV, AM
                 k = k + 1
         End Select
         Select Case rjec
             Case ZB, JP, SM, JM, BD, FI, RV, AM
                 h = h + 1
         End Select
         Select Case tbc
             Case ZB, JP, SM, JM, BD, FI, RV, AM
                 j = j + 1
         End Select
        
  Next
  
  Cells(18, 3) = g
  Cells(19, 3) = e
  Cells(20, 3) = f
  Cells(21, 3) = k
  Cells(22, 3) = h
  Cells(23, 3) = j

 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True
 End Sub
A+
 
Vote positif 0 Vote négatif
B

Bill607

XLDnaute Nouveau
Re : Boucle For bug ! help ! VBA !

Merci pour ta réponse rapide ;)

J'ai essayé et ca plante toujours quand je dépasse les 20 ...

J'ai trouvé une autre solution pour lire dans une cellule, à savoir :

Code: 
Cells(i,1)= "='C:\Users\h.elbilali\Desktop\nuria\[extraction_client_prod__Macro.xlsm]No_invoicing'!$A1"

Ceci marche super, mais quand je veux récupérer une plage pour faire mes stats après : je fais ça
Code: 
For i = 1 To 20
    cellule = "A" & i   ' pour avoir les A1, A2 ..... A20
    Cells(i, 9) = "='C:\Users\h.elbilali\Desktop\nuria\[extraction_client_prod__Macro.xlsm]No_invoicing'!$cellule" <- Erreur ici !!!!

Grosse erreur : " Erreur définie par l'application ou par l'objet
 
Vote positif 0 Vote négatif
B

Bill607

XLDnaute Nouveau
Re : Boucle For bug ! help ! VBA !

ils sont déclarer comme suit :
Dim ZB As String
et les autres aussi ..

Mais ce n'est plus ca le problèmemais plutôt ça :

For i = 1 To 20
cellule = "A" & i ' pour avoir les A1, A2 ..... A20
Cells(i, 9) = "='C:\Users\h.elbilali\Desktop\nuria\[extraction_client_prod__Macro.xlsm]No_invoicing'!$cellule" <- Erreur ici !!!!
Next

Je n'arrive pas lui faire comprendre que cellule est de la forme A1, A2 ....A20 !!!!!!!
 
Vote positif 0 Vote négatif
fhoest

fhoest

XLDnaute Accro
Re : Boucle For bug ! help ! VBA !

Re,
il faut déclarer cellule en range:
Code: 
dim cellule as range
cellule=Range("A"& i ).Address
Cells(i, 9) = "='C:\Users\h.elbilali\Desktop\nuria\[extraction_client_prod__Macro.xlsm]No_invoicing'!"& cellule
A tester.
 
Vote positif 0 Vote négatif
B

Bill607

XLDnaute Nouveau
Re : Boucle For bug ! help ! VBA !

Bonjour Fhoest,

La formule marche très bien !
Maintenant je voudrai tester les valeurs qu'elle me renvoie pour enfin commencer mes stats
Alors j'ai fait ça :

Code: 
For i = 1 To 20
       
    ZB = "='S:\PARIS-VAT\[UNDUE_VAT_REPORT_TABLE_Macro1.xlsm]ZB'!" & Range("L" & i).Address
    JP = "='S:\PARIS-VAT\[UNDUE_VAT_REPORT_TABLE_Macro1.xlsm]JP'!" & Range("L" & i).Address
    SM = "='S:\PARIS-VAT\[UNDUE_VAT_REPORT_TABLE_Macro1.xlsm]SM'!" & Range("L" & i).Address
       
        og = "Ongoing"
        dv = "Due VAT"
       
        
        Select Case cnR
            Case ZB, JP, SM
                g = g + 1
        End Select
        Select Case dv
            Case ZB, JP, SM
                e = e + 1
        End Select
               
 Next

Comment je déclare les ZB, JP et SM vu que c'est l'adresse d'un Range ... ?
On est d'accord que dv et og doivent être déclarer comme :
Dim dv, og As String ?

Mercii !
 
Vote positif 0 Vote négatif
fhoest

fhoest

XLDnaute Accro
Re : Boucle For bug ! help ! VBA !

Bonjour,
personnellement je ferais comme ça:
Code: 
Dim Object As Workbook
Dim WK As String
WK = "S:\PARIS-VAT\UNDUE_VAT_REPORT_TABLE_Macro1.xlsm"
For i = 1 To 20
        Set Object = GetObject(WK)
With Object
ZB = .Sheets("nom_de_feuille").Range("L" & i).Text
JP = .Sheets("nom_de_feuille").Range("L" & i).Text
SM = .Sheets("nom_de_feuille").Range("L" & i).Text
End With
Set Object = Nothing
    MsgBox ZB
    MsgBox JP
    MsgBox SM
    
         og = "Ongoing"
         dv = "Due VAT"
        
         
         Select Case cnR
             Case ZB, JP, SM
                 g = g + 1
         End Select
         Select Case dv
             Case ZB, JP, SM
                 e = e + 1
         End Select
                
  Next
pour déclarer correctement tu dois séparer les instructions en spécifiant le type a chaque fois,
exemple :
Code: 
dim dv,og as string
'dv est en variant et og en string
'tandis que:
dim dv as string,og as string 'les deux sont en string
A+
 
Vote positif 0 Vote négatif
B

Bill607

XLDnaute Nouveau
Re : Boucle For bug ! help ! VBA !

Salut fhoest,

Je reviens ici pour un autre sujet, et j'aimerai connaitre ton retour s'il te plaît.

Je souhaite remplir des champs ( id, password... ) et cliquer sur des boutons ( login, Next .. . ) via une macro en vba.

Voilà le code que j'ai fait :

Code: 
Sub WaitIE(ie As InternetExplorer)
   'On boucle tant que la page n'est pas totalement chargée
   Do Until ie.readyState = READYSTATE_COMPLETE
      DoEvents
   Loop
End Sub

__________________________________________________________________________

Sub RechercheVBAExcel()

'Déclaration des variables
Dim ie As New InternetExplorer
Dim IEDoc As HTMLDocument
Dim Input_Id_password As HTMLInputElement
Dim bouton_Login As HTMLInputElement
Dim bouton_Next As HTMLInputElement
Dim FormGoogleCherche As HTMLFormElement

   ie.Navigate "https://online.hmrc.gov.uk/login?GAREASONCODE=-1&GARESOURCEID=Common&GAURI=https://online.hmrc.gov.uk/home&Reason=-1&APPID=Common&URI=https://online.hmrc.gov.uk/home" 'Chargement d'une page Web Google
   ie.Visible = True 'Affichage de la fenêtre IE
   WaitIE ie 'On attend le chargement complet de la page
   Set IEDoc = ie.document 'On pointe le membre Document
   
   Set InputId_password = IEDoc.all("userId") 'On pointe notre Zone de texte
   Input_Id_password.Value = "xxxxx" 'On définit le texte que l'on souhaite placer à l'intérieur
   Set InputId_password = IEDoc.all("password") 'On pointe notre Zone de texte
   Input_Id_password.Value = "xxxxx" 'On définit le texte que l'on souhaite placer à l'intérieur
   
     
   Set bouton_Login = IEDoc.getElementById("ButtonLogin") 'On pointe notre bouton
   bouton_Login.Click 'On simule un clic
   WaitIE ie 'On attend la fin de la recherche
   
   
    [B][COLOR="#FF0000"]Set bouton_Next = IEDoc.getElementById("ButtonNext") 'On pointe notre bouton
   bouton_Next.Click 'On simule un clic
   WaitIE ie 'On attend la fin de la recherche[/COLOR][/B]
   
  
   'On libère les variables
   
   Set ie = Nothing
   Set IEDoc = Nothing
 
End Sub

Tout marche bien sauf quand j'arrive dans la partie rouge ... Erreur 91 : Variable objet ou variable de bloc With Non définie ...


Je comprends pas alors que la partie de code quand je clique sur LOgin marche très bien pourtant c'est la meme...

Voilà le code source extrait de la console ( F12 ) du bouton Next :
Code: 
<input id="ButtonNext" type="submit" value="Next">

Du bouton Login :
Code: 
<button type="submit" tabindex="1" id="ButtonLogin">Login</button>

Merci d'avance pour votre aide :( :(
 
Vote positif 0 Vote négatif
fhoest

fhoest

XLDnaute Accro
Re : Boucle For bug ! help ! VBA !

Bonjour,
je viens juste de revenir de congé pour moi le problème vient du fait que tu sors du sub. (donc les déclarations dim ne sont plus valide
écris les tout en haut avant tout le code.
A+
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

P
  • Question
Boucle FOR +IF incompatible
2
Réponses
19
Affichages
2 K
piegre
P
B
  • Question
Lecture dans un classeur fermé excel 2010 .xlsx
Réponses
10
Affichages
2 K
Bill607
B
F
  • Question
Au secours - Boucle vba qui fait n'importe quoi.
Réponses
3
Affichages
7 K
Jam
Jam
criscris11
  • Question
Perte de focus après saisie de la première lettre
Réponses
12
Affichages
2 K
criscris11
criscris11
T
  • Question
[Besoin de méthode d'optimisation de temps de traitement, macro VBA][RESOLU]
2
Réponses
22
Affichages
6 K
Thibault LB
T
iStarOSX
  • Question
Simplification de code VBA
Réponses
8
Affichages
2 K
iStarOSX
iStarOSX
H
  • Question
macro boucle de A à IK
Réponses
5
Affichages
992
Pierrot93
Pierrot93

Membres actuellement en ligne

5 membres et 66 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 644
Messages
2 111 528
Membres
111 189
dernier inscrit
Laurent.