VBA - Aide pour simplifications de macros [RESOLU x2]

R

r1v3r

XLDnaute Nouveau
nouvelle demande ICI


bonjour,

dans mon fichier excel j'utilise 2 macros me permettant de mettre a jour une multitude de données externes via des requêtes web successives (1 requête différente pour chaque ligne de mon tableau).
J'ai découvert les macros que récemment donc j'ai quelques notions mais je ne suis vraiment pas un crack.
Mon premier problème : sous mac (excel 2011 - OSX Lion) je ne peux pas exécuter 2 fois de suite l'une ou l'autre des macros sous peine d'un plantage général d'excel // sous windows 7 ca fonctionne autant de fois que l'on veut.
Mon deuxième problème : j'utilise pas mal de ".select" car cela me permet de voir l'avancement de la mise à jour mais je sais qu'on conseille souvent de limiter l'utilisation de .select donc je souhaiterais savoir si l'on peut optimiser ces macros tout en conservant la visibilité de l'avancement.

Je ne peux pas poster le fichier donc je laisse ci-dessous les 2 macros.

Merci d'avance pour votre aide et vos conseils.



MACRO n°1 :

Sub ALL()
'
' ALL Macro
'

'
ThisWorkbook.Activate
Sheets("INFO").Range("H10").Select
Sheets("IMPORT").Range("B2").QueryTable.Refresh BackgroundQuery:=False
Application.Wait Now + TimeValue("00:00:05")
Sheets("INFO").Range("H11").Select
Sheets("IMPORT").Range("B12").QueryTable.Refresh BackgroundQuery:=False
Application.Wait Now + TimeValue("00:00:05")
Sheets("INFO").Range("H12").Select
Sheets("IMPORT").Range("B22").QueryTable.Refresh BackgroundQuery:=False
Application.Wait Now + TimeValue("00:00:05")
[...] ainsi de suite jusque
Sheets("INFO").Range("H96").Select
Sheets("IMPORT").Range("B862").QueryTable.Refresh BackgroundQuery:=False
Application.Wait Now + TimeValue("00:00:05")
Sheets("INFO").Range("H9").Select
ActiveWorkbook.Save
End Sub


MACRO n°2 :

Sub SPEED()
'
' SPEED Macro
'

'
ThisWorkbook.Activate
Sheets("INFO").Range("H10").Select
If Sheets("INFO").Range("C10") = "" Then
Sheets("IMPORT").Range("B2").QueryTable.Refresh BackgroundQuery:=False
Application.Wait Now + TimeValue("00:00:05")
End If
Sheets("INFO").Range("H11").Select
If Sheets("INFO").Range("C11") = "" Then
Sheets("IMPORT").Range("B12").QueryTable.Refresh BackgroundQuery:=False
Application.Wait Now + TimeValue("00:00:05")
End If
[...] ainsi de suite jusque
Sheets("JOUEUR").Range("H96").Select
If Sheets("INFO").Range("C96") = "" Then
Sheets("IMPORT").Range("B862").QueryTable.Refresh BackgroundQuery:=False
Application.Wait Now + TimeValue("00:00:05")
End If
Sheets("INFO").Range("H9").Select
ActiveWorkbook.Save
End Sub

La temporisation de 5 seconde est obligatoire sinon j'ai un blocage d'accès au données (une protection des sites hébergeant les infos probablement)
Je n'utilise pas les instructions"Application.ScreenUpdating" et "Application.Calculation" pour vérifier l'avancement et parce qu'en fonction des données mise à jour au fur et à mesure le résultat d'un calcul peut varier et c'est ce qui m’intéresse essentiellement.

a bientot :)
 
Dernière édition:
Trier par date Trier par votes
B

Bebere

XLDnaute Barbatruc
Re : VBA - Besoin d'aide pour simplifier 2 macros

bonjour r1v3r
bienvenue
code à tester
Code: 
Sub essai()
Dim L As Long, Li As Long
Li = 2
With ThisWorkbook
For L = 10 To 96
.Sheets("INFO").Range("H" & L).Select
.Sheets("IMPORT").Range("B" & Li).QueryTable.Refresh BackgroundQuery:=False
Application.Wait Now + TimeValue("00:00:05")
Li = Li + 10 'écart 10 d'après ton code
Next L
.Sheets("INFO").Range("H9").Select
.Save
End With

End Sub
 
Vote positif 0 Vote négatif
R

r1v3r

XLDnaute Nouveau
Re : VBA - Besoin d'aide pour simplifier 2 macros

bonjour,

merci Bebere :).

Ca fonctionne bien mais :
1 il peut arriver que la requête mène à une info non disponible (page web vierge) et du coup dans mon cas aujourd'hui à L = 17 j'obtiens une erreur d'exécution "1004".
Est-il possible de lui indiquer que si cela arrive il passe l'erreur et continue le reste ?

2 Concernant la 2e macro, elle fait la même chose mais que pour les infos qui ne sont pas déjà récupérées en vérifiant la colonne "C" -- dans la colonne "C" j'ai la formule "=SI($H..<>"";"X";"")
Peut on la simplifier de la même manière ?

3 Excel plante encore si on exécute 2 fois la macro. Je pensais que cela venait de ma macro un peu surchargée mais faut croire que non.

Merci beaucoup, à bientôt
 
Vote positif 0 Vote négatif
R

r1v3r

XLDnaute Nouveau
Re : VBA - Besoin d'aide pour simplifier 2 macros

Au temps pour moi pour le cas n°1 : google est ton ami avant tout, j'ai parlé trop vite --> On Error Resume Next
On a donc :
Code: 
Sub essai()
Dim L As Long, Li As Long
Li = 2
With ThisWorkbook
For L = 10 To 96
.Sheets("INFO").Range("H" & L).Select
.Sheets("IMPORT").Range("B" & Li).QueryTable.Refresh BackgroundQuery:=False
On Error Resume Next
Application.Wait Now + TimeValue("00:00:05")
Li = Li + 10 'écart 10 d'après ton code
Next L
.Sheets("INFO").Range("H9").Select
.Save
End With

End Sub

Reste 2 et eventuellement 3. :)
 
Vote positif 0 Vote négatif
R

r1v3r

XLDnaute Nouveau
Re : VBA - Besoin d'aide pour simplifier 2 macros

J'ai pas compris. :confused:
j'ai juste rajouté "On Error Resume Next" en cas de données non disponibles.

Pour la macro de maj rapide en ne comblant que les manquants, j'ai essayé selon le modèle :
Code: 
Sub BEST_SPEED()
    Dim L As Long, Li As Long
    Li = 2
        With ThisWorkbook
            For L = 10 To 96
                If Sheets("INFO").Range("C" & L) = "" Then
                    .Sheets("INFO").Range("H" & L).Select
                    .Sheets("IMPORT").Range("B" & Li).QueryTable.Refresh BackgroundQuery:=False
                    On Error Resume Next
                    Application.Wait Now + TimeValue("00:00:05")
                    Li = Li + 10
                    Next L
                Else: Next L
                End If
        .Sheets("INFO").Range("H9").Select
        .Save
        End With

End Sub

Mais ca coince sur le 1er "next" avec une "erreur de compilation : Next sans For"
 
Vote positif 0 Vote négatif
B

Bebere

XLDnaute Barbatruc
Re : VBA - Besoin d'aide pour simplifier 2 macros

bonjour
le next était dans if..end if
Code: 
Sub BEST_SPEED()
    Dim L As Long, Li As Long
    Li = 2
    With ThisWorkbook
        For L = 10 To 96
            If Sheets("INFO").Range("C" & L) = "" Then
                .Sheets("INFO").Range("H" & L).Select
                .Sheets("IMPORT").Range("B" & Li).QueryTable.Refresh BackgroundQuery:=False
                On Error Resume Next
                Application.Wait Now + TimeValue("00:00:05")
                Li = Li + 10
            End If
        Next L
        .Sheets("INFO").Range("H9").Select
        .Save
    End With

End Sub
 
Vote positif 0 Vote négatif
R

r1v3r

XLDnaute Nouveau
Re : VBA - Besoin d'aide pour simplifier 2 macros

impeccable !
J'avais écris de façon trop littérale :

if "C" = RIEN alors mettre à jour sinon passer a next directement --> If ... Else
apres une mise à jour passer à next --> End If Next

Enfin bref ça fonctionne c'est le principal.
Je te remercie pour ton aide.

Reste le plantage d'excel si j'execute 2 mise à jour consécutivement. Je pense pas ce soit la macro mais le logiciel qui deconne.

Merci et a bientot
 
Vote positif 0 Vote négatif
R

r1v3r

XLDnaute Nouveau
Re : VBA - Aide pour simplifications de macros [RE-OUVERT]

Bonjour à tous,

je ré ouvre ce fil car ma demande est une suite (ou maj) du code initial.

le fait de mettre a jour via les .refresh provoquait des décalages aléatoires que je n'ai pas réussi à résoudre.
Du coup la nouvelle methode employée fonctionne bien sans décalage mais je bloque encore une fois sur la simplification du code.

la macro telle qu'elle est :

Code: 
Sub ALL()

ThisWorkbook.Activate

Sheets("JOUEUR").Range("I10").Select

    With Sheets("IMPORT").QueryTables.Add(Connection:="URL;http://www.turf-fr.com/cgi-bin/concours/fiche.cgi?part=28884&pseudo=Albert59", _
    Destination:=Sheets("IMPORT").Range("B1"))
    On Error Resume Next
    .PreserveFormatting = False
    .BackgroundQuery = True
    .RefreshStyle = xlOverwriteCells
    .AdjustColumnWidth = False
    .Refresh BackgroundQuery:=False
End With

Application.Wait Now + TimeValue("00:00:05")

Sheets("JOUEUR").Range("I11").Select

    With Sheets("IMPORT").QueryTables.Add(Connection:="URL;http://www.turf-fr.com/cgi-bin/concours/fiche.cgi?part=21538&pseudo=Alnu", _
    Destination:=Sheets("IMPORT").Range("B21"))
    On Error Resume Next
    .PreserveFormatting = False
    .BackgroundQuery = True
    .RefreshStyle = xlOverwriteCells
    .AdjustColumnWidth = False
    .Refresh BackgroundQuery:=False
    End With

Application.Wait Now + TimeValue("00:00:05")


etc...

du coup en reprenant la solution précédemment trouvée j'ai essayé :

Code: 
Sub TEST()

Dim L As Long, Li As Long, Ln As Long, sURL As String
Li = 1

With ThisWorkbook

For L = 10 To 137
.Sheets("JOUEUR").Range("H" & L).Select

On Error Resume Next

For Ln = 1 To 128
sURL = Sheets("URLs").Range("$I$" & Ln).Value

    With Sheets("IMPORT")
        .QueryTables.Add(Connection:="URL," & sURL, Destination:=Sheets("IMPORT").Range("$B$" & Li))
            .PreserveFormatting = False
            .BackgroundQuery = True
            .RefreshStyle = xlOverwriteCells
            .AdjustColumnWidth = False
            .Refresh BackgroundQuery:=False

                Application.Wait Now + TimeValue("00:00:05")
        Li = Li + 20
        Next Ln
        Next L
    End With

.Sheets("JOUEUR").Range("I6").Select
.Save
End With

End Sub

Ce code ne fonctionnant pas.

sachant que :
dans l'onglet "URLs" se situe dans la colonne "I" (de la ligne 1 à 128) les url au format texte des données à récupérer.
dans l'onglet "IMPORT" les données sont espacées toutes les 20 lignes depuis la ligne n°1

Je vous remercie pour votre aide.
 
Vote positif 0 Vote négatif
B

Bebere

XLDnaute Barbatruc
Re : VBA - Aide pour simplifications de macros [RE-OUVERT]

bonjour r1v3r
en piochant de droite à gauche essaye ce qui suit
en lisant j'en ai conclu que toutes les feuilles sont dans le même classeur

Code: 
Sub TEST()

    Dim L As Long, Li As Long, Ln As Long, sURL As String, Qt As QueryTable
    Li = 1

    With ThisWorkbook

        For L = 10 To 137
            .Sheets("JOUEUR").Range("H" & L).Select
            For Ln = 1 To 128
                sURL = .Sheets("URLs").Range("$I$" & Ln).Value

                On Error Resume Next

                Set Qt = .Sheets("IMPORT").QueryTables.Add(Connection:="URL," & sURL, Destination:=Sheets("IMPORT").Range("$B$" & Li))
                With Qt
                    .PreserveFormatting = False
                    .BackgroundQuery = True
                    .RefreshStyle = xlOverwriteCells
                    .AdjustColumnWidth = False
                    .Refresh BackgroundQuery:=False
                    Application.Wait Now + TimeValue("00:00:05")
                End With
                Li = Li + 20
            Next Ln

        Next L
        .Sheets("JOUEUR").Range("I6").Select
        .Save
    End With

End Sub
'ce qui suit ,à tester.Dans le code précédent il manquait un . devant sheets
Sub BEST_SPEED()
    Dim L As Long, Li As Long
    Li = 2
    With ThisWorkbook.Sheets("INFO")
        For L = 10 To 96
            If .Range("C" & L) = "" Then
                .Range("H" & L).Select
                .Range("B" & Li).QueryTable.Refresh BackgroundQuery:=False
                On Error Resume Next
                Application.Wait Now + TimeValue("00:00:05")
                Li = Li + 10
            End If
        Next L
        .Range("H9").Select
        .Save
    End With

End Sub
 
Vote positif 0 Vote négatif
R

r1v3r

XLDnaute Nouveau
Re : VBA - Aide pour simplifications de macros [RE-OUVERT]

Bonsoir,

Merci Bebere.
==> j'obtiens une erreur de compilation : membre de méthode ou de données introuvable
portant sur la ligne .PreserveFormatting = False

en supprimant simplement la ligne, la macro s'execute mais rien ne se passe.

J'en profite au passage pour demander quels seraient les lignes de paramètres à entrer pour n'extraire que le texte sans les couleurs sans les cadres etc...
 
Vote positif 0 Vote négatif
R

r1v3r

XLDnaute Nouveau
Re : VBA - Aide pour simplifications de macros [RE-OUVERT]

bonsoir,

en pièce jointe le fichier allégé : 5 requêtes en tout.
J'ai pré adapté la macro pour ces 5 là uniquement.

En haut à gauche de l'onglet "JOUEUR" se trouvent les boutons liés aux macros.
la macro "ALL" fait exactement ce que je veux
"TEST" defile très lentement et n'execute pas les requetes web

J'ai eu beau nettoyé les "Names" et les connexions extenes via la macro "RAZ" l'onglet "IMPORT" excel rame pas mal je ne sais pas pourquoi...

Si il y a des paramètres de querytables qui empêche la sauvegarde de ces connexions ce serait cool.
et idem pour que la requete ne télécharge que le texte contenu sans les couleurs, les bordures, etc...


Merci beaucoup. :)
 

Pièces jointes

  • TEST.xlsm
    56.1 KB · Affichages: 69
  • TEST.xlsm
    56.1 KB · Affichages: 77
  • TEST.xlsm
    56.1 KB · Affichages: 74
Dernière édition:
Vote positif 0 Vote négatif
B

Bebere

XLDnaute Barbatruc
Re : VBA - Aide pour simplifications de macros [RE-OUVERT]

bonjour r1v3r
avec la macro module1 résultat dans import
teste de ton côté
à mon avis il faut faire une requête plus ciblée
code requête obtenu via enregistreur macro
 

Pièces jointes

  • TESTv1.xlsm
    57.1 KB · Affichages: 62
  • TESTv1.xlsm
    57.1 KB · Affichages: 76
  • TESTv1.xlsm
    57.1 KB · Affichages: 72
Vote positif 0 Vote négatif
R

r1v3r

XLDnaute Nouveau
Re : VBA - Aide pour simplifications de macros [RE-OUVERT]

bonjour bebere.

en testant différentes choses je me rend compte que :
* Excel 2010 sous Windows extrait bien le texte uniquement
* Excel 2011 sous Mac ne prend pas en compte le paramètre de la table à extraire et récupère donc la page entière avec les couleurs etc...

--> les requêtes ne pouvant être enregistrées sous Mac (car la fonction "obtenir des données depuis le web" n'existe pas sous excel 2011 Mac) je vais étalonner les cellules pour que la mise en forme ne soit pas modifiée de windows à mac.


Sans quoi, le module1 (macro2) dans TESTv1 ne fonctionne pas sous mac mais c'est bon sous windows.
--> erreur 438 : la ligne .PreserveFormatting est surlignée en jaune dans le débogage.
Il est IMPERATIF de laisser les 5 secondes entre chaque requête sinon on est bloqué par le site.
Je souhaite aussi garder la possibilité de suivre la progression de la mise à jour depuis l'onglet "JOUEUR" (on lance les macros depuis cet onglet)

Enfin je ne comprends pas les modifs apportées en vert dans la macro "test" ?

j'effectue les petits réglages et je reposte le fichier pour la suite.

en te remerciant.
 
Vote positif 0 Vote négatif

Discussions similaires

A
  • Résolu(e)
Microsoft 365 With Selection.Parent.MailEnvelope.Item
Réponses
13
Affichages
503
patricktoulon
patricktoulon
M
  • Résolu(e)
XL 2016 Amélioration de code
Réponses
3
Affichages
344
M@xu3L
M
tactic6
  • Question
XL 2016 Aide pour userform (sujet clos)
Réponses
8
Affichages
156
tactic6
tactic6
Y
  • Question
XL 2013 Envoie de P-J sil existe par mail Macro VBA
Réponses
1
Affichages
518
kiki29
kiki29
R1-
  • Question
XL 2016 Impossible de SendKeys une tabulation
Réponses
4
Affichages
421
R1-
R1-
Mr.Adrien
  • Question
Microsoft 365 Cherche une personne pouvant m'aider à transformer des codes VBA pour Google Sheet
Réponses
6
Affichages
629
bruderez
B
KTM
  • Question
XL 2016 rafraîchir écran
Réponses
0
Affichages
701
KTM
KTM
M
  • Question
XL 2016 VBA > Réactualisation d'un TCD à l'ouverture du fichier qui ne passe pas
Réponses
3
Affichages
1 K
Phil69970
Phil69970
N
  • Question
XL 2016 [RESOLU] Séquençage des rafraichissement de plusieurs tables (Power Query)
Réponses
10
Affichages
4 K
Nicocotte125
N
M
  • Question
Microsoft 365 Programme trop lent
Réponses
12
Affichages
665
Hasco
Hasco

Membres actuellement en ligne

15 membres et 121 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
312 109
Messages
2 085 386
Membres
102 881
dernier inscrit
Talib