VBA - Aide pour simplifications de macros [RESOLU x2]

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:

r1v3r

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

enfin de compte c'est plus compliqué. Tous ces paramètres ne sont pas reconnus pas Excel MAC :
'.PreserveFormatting =
'.RefreshPeriod =
'.WebSelectionType =
'.WebFormatting =
'.WebTables =
'.WebPreFormattedTextToColumns =
'.WebConsecutiveDelimitersAsOne =
'.WebSingleBlockTextImport =
'.WebDisableDateRecognition =
'.WebDisableRedirections =

ça explique du coup la mise en forme différente d'une plateforme à une autre et le problème des tables extraites.

Mon souhait de base reste possible mais avec plus de contraintes.
 

Bebere

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

bonjour r1v3r
ce code donne un résultat sans format

Code:
Sub URLGetQuery()
  With ActiveSheet.QueryTables.Add(Connection:= _
 "URL;http://www.turf-fr.com/cgi-bin/concours/fiche.cgi?part=28884&pseudo=Albert59", Destination:=Range("a1"))
.WebFormatting = xlWebFormattingNone
 .BackgroundQuery = True
 .TablesOnlyFromHTML = True
 .Refresh BackgroundQuery:=False
 .SaveData = True
 End With
End Sub
 

r1v3r

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

bonjour,

hélas non sous excel mac j'ai toujours les couleurs d'arrière plan et les polices etc...
mais c'est pas si grave.


le fichier joint est correctement aligné avec ta proposition de code. Cela fonctionne de façon normale dans la mesure où l'on lance la macro depuis l'onglet "JOUEUR" via un des boutons en bleu en haut à gauche.
Je souhaite donc pour le finaliser voir dans l'onglet "joueur" les Range("I" & Li).Select pour Li = 10 to 29 (dans le fichier test) afin que cela se comporte comme la macro "ALL"

--> en ajoutant simplement cette ligne de code comme dans ta 1ere proposition POST #10 cela ne fonctionne pas...

merci
 

Pièces jointes

  • TESTv2.xlsm
    55.3 KB · Affichages: 64
  • TESTv2.xlsm
    55.3 KB · Affichages: 76
  • TESTv2.xlsm
    55.3 KB · Affichages: 77

r1v3r

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

re bonjour (bonsoir)

finalement j'ai trouvé en trichant un peu. je pense ca marchait pas bien à cause de l'utilisation de plusieurs variables.
Donc j'ai rajouté une ligne en réutilisant la variable déjà définie 'i'.
--> Sheets("JOUEUR").Range("I" & i + 27).Select

Au final la macro fonctionne bien comme je le souhaite :
Code:
Sub ALL()

ThisWorkbook.Activate

L = 1

    ActiveWorkbook.Worksheets("JOUEUR").Activate

            For i = 1 To 130
                 sURL = ActiveWorkbook.Worksheets("URLs").Range("G" & i).Value
                 Sheets("JOUEUR").Range("I" & i + 27).Select

                On Error Resume Next
    
                    With ActiveWorkbook.Worksheets("IMPORT").QueryTables.Add(Connection:="URL;" & sURL, Destination:=Worksheets("IMPORT").Range("B" & L))
                    .BackgroundQuery = True
                    .TablesOnlyFromHTML = True
                    .RefreshStyle = xlOverwriteCells
                    .SaveData = True
                    .AdjustColumnWidth = False
                    .Refresh BackgroundQuery:=False
                    End With
                    
                    Application.Wait Now + TimeValue("00:00:05")
    
                    L = L + 20

            Next i

    ActiveWorkbook.Worksheets("JOUEUR").Range("I6").Select
    ActiveWorkbook.Save

End Sub

En tout cas je te remercie bebere encore une fois. C'est vraiment sympa d'avoir pris le temps.

Ce problème est résolu. :D
 

Discussions similaires

Réponses
0
Affichages
712
Réponses
12
Affichages
677

Statistiques des forums

Discussions
312 189
Messages
2 086 031
Membres
103 101
dernier inscrit
CyberAlex93