Simplification de Macro

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion cissou69
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
C

cissou69

XLDnaute Junior
Bonjour,

Je suis tout débutant en programmation VBA sous Excel et j'ai créé cette macro qui me sert à rapatrier des données depuis un serveur avec un logiciel particulier "PI".
Mon souci est que je la trouve très répétitive... je pense qu'il est faisable d'améliorer ça mais je ne sais pas comment ?!

J'ai copié le code ci-dessous :

Code: 
Sub Recup_PI_EP8()
'
' Recup_PI_EP8 Macro
' Macro recorded 15/07/2010 by Cissou
'
'
Dim sTagname As String
Dim sTime As String
Dim sServer As String
Dim macroResult As Variant

sServer = "10.123.456.78"

i = 8
j = 8
a = 1
b = 1

' Recherche des dates
Do While a <> ""
    a = Cells(j, 7).Value
    j = j + 1
Loop
j = j - 2
    
' Recherche des valeurs pour le premier tag
Do While b <> ""
    b = Cells(i, 21).Value
    i = i + 1
Loop
i = i - 2

If i < j Then
    For k = i + 1 To j
        sTime = Cells(k, 7).Value
        sTagname = Cells(5, 21).Value
        macroResult = Application.Run("PITimeDat", sTagname, sTime, sServer)
        Cells(k, 21).Value = macroResult
        If Cells(k, 21).Value = "No Data" Then
            Cells(k, 21).Value = ""
        End If
    Next
                     
End If

' L'opération est répétée pour chaque tag désiré, le code est copié, seule la colonne est modifiée

i = 8
b = 1

Do While b <> ""
    b = Cells(i, 22).Value
    i = i + 1
Loop
i = i - 2

If i < j Then
    For k = i + 1 To j
        sTime = Cells(k, 7).Value
        sTagname = Cells(5, 22).Value
        macroResult = Application.Run("PITimeDat", sTagname, sTime, sServer)
        Cells(k, 22).Value = macroResult
        If Cells(k, 22).Value = "No Data" Then
            Cells(k, 22).Value = ""
        End If
    Next
                     
End If

i = 8
b = 1

Do While b <> ""
    b = Cells(i, 23).Value
    i = i + 1
Loop
i = i - 2

If i < j Then
    For k = i + 1 To j
        sTime = Cells(k, 7).Value
        sTagname = Cells(5, 23).Value
        macroResult = Application.Run("PITimeDat", sTagname, sTime, sServer)
        Cells(k, 23).Value = macroResult
        If Cells(k, 23).Value = "No Data" Then
            Cells(k, 23).Value = ""
        End If
    Next
                     
End If

i = 8
b = 1

Do While b <> ""
    b = Cells(i, 24).Value
    i = i + 1
Loop
i = i - 2

If i < j Then
    For k = i + 1 To j
        sTime = Cells(k, 7).Value
        sTagname = Cells(5, 24).Value
        macroResult = Application.Run("PITimeDat", sTagname, sTime, sServer)
        Cells(k, 24).Value = macroResult
        If Cells(k, 24).Value = "No Data" Then
            Cells(k, 24).Value = ""
        End If
    Next
                     
End If

i = 8
b = 1

Do While b <> ""
    b = Cells(i, 25).Value
    i = i + 1
Loop
i = i - 2

If i < j Then
    For k = i + 1 To j
        sTime = Cells(k, 7).Value
        sTagname = Cells(5, 25).Value
        macroResult = Application.Run("PITimeDat", sTagname, sTime, sServer)
        Cells(k, 25).Value = macroResult
        If Cells(k, 25).Value = "No Data" Then
            Cells(k, 25).Value = ""
        End If
    Next
                     
End If

i = 8
b = 1

Do While b <> ""
    b = Cells(i, 26).Value
    i = i + 1
Loop
i = i - 2

If i < j Then
    For k = i + 1 To j
        sTime = Cells(k, 7).Value
        sTagname = Cells(5, 26).Value
        macroResult = Application.Run("PITimeDat", sTagname, sTime, sServer)
        Cells(k, 26).Value = macroResult
        If Cells(k, 26).Value = "No Data" Then
            Cells(k, 26).Value = ""
        End If
    Next
                     
End If

i = 8
b = 1

Do While b <> ""
    b = Cells(i, 27).Value
    i = i + 1
Loop
i = i - 2

If i < j Then
    For k = i + 1 To j
        sTime = Cells(k, 7).Value
        sTagname = Cells(5, 27).Value
        macroResult = Application.Run("PITimeDat", sTagname, sTime, sServer)
        Cells(k, 27).Value = macroResult
        If Cells(k, 27).Value = "No Data" Then
            Cells(k, 27).Value = ""
        End If
    Next
                     
End If

i = 8
b = 1

Do While b <> ""
    b = Cells(i, 28).Value
    i = i + 1
Loop
i = i - 2

If i < j Then
    For k = i + 1 To j
        sTime = Cells(k, 7).Value
        sTagname = Cells(5, 28).Value
        macroResult = Application.Run("PITimeDat", sTagname, sTime, sServer)
        Cells(k, 28).Value = macroResult
        If Cells(k, 28).Value = "No Data" Then
            Cells(k, 28).Value = ""
        End If
    Next
                     
End If

i = 8
b = 1

Do While b <> ""
    b = Cells(i, 29).Value
    i = i + 1
Loop
i = i - 2

If i < j Then
    For k = i + 1 To j
        sTime = Cells(k, 7).Value
        sTagname = Cells(5, 29).Value
        macroResult = Application.Run("PITimeDat", sTagname, sTime, sServer)
        Cells(k, 29).Value = macroResult
        If Cells(k, 29).Value = "No Data" Then
            Cells(k, 29).Value = ""
        End If
    Next
                     
End If

i = 8
b = 1

Do While b <> ""
    b = Cells(i, 30).Value
    i = i + 1
Loop
i = i - 2

If i < j Then
    For k = i + 1 To j
        sTime = Cells(k, 7).Value
        sTagname = Cells(5, 30).Value
        macroResult = Application.Run("PITimeDat", sTagname, sTime, sServer)
        Cells(k, 30).Value = macroResult
        If Cells(k, 30).Value = "No Data" Then
            Cells(k, 30).Value = ""
        End If
    Next
                     
End If

i = 8
b = 1

Do While b <> ""
    b = Cells(i, 31).Value
    i = i + 1
Loop
i = i - 2

If i < j Then
    For k = i + 1 To j
        sTime = Cells(k, 7).Value
        sTagname = Cells(5, 31).Value
        macroResult = Application.Run("PITimeDat", sTagname, sTime, sServer)
        Cells(k, 31).Value = macroResult
        If Cells(k, 31).Value = "No Data" Then
            Cells(k, 31).Value = ""
        End If
    Next
                     
End If


i = 8
b = 1

Do While b <> ""
    b = Cells(i, 32).Value
    i = i + 1
Loop
i = i - 2

If i < j Then
    For k = i + 1 To j
        sTime = Cells(k, 7).Value
        sTagname = Cells(5, 32).Value
        macroResult = Application.Run("PITimeDat", sTagname, sTime, sServer)
        Cells(k, 32).Value = macroResult
        If Cells(k, 32).Value = "No Data" Then
            Cells(k, 32).Value = ""
        End If
    Next
                     
End If


i = 8
b = 1

Do While b <> ""
    b = Cells(i, 33).Value
    i = i + 1
Loop
i = i - 2

If i < j Then
    For k = i + 1 To j
        sTime = Cells(k, 7).Value
        sTagname = Cells(5, 33).Value
        macroResult = Application.Run("PITimeDat", sTagname, sTime, sServer)
        Cells(k, 33).Value = macroResult
        If Cells(k, 33).Value = "No Data" Then
            Cells(k, 33).Value = ""
        End If
    Next
                     
End If

i = 8
b = 1

Do While b <> ""
    b = Cells(i, 34).Value
    i = i + 1
Loop
i = i - 2

If i < j Then
    For k = i + 1 To j
        sTime = Cells(k, 7).Value
        sTagname = Cells(5, 34).Value
        macroResult = Application.Run("PITimeDat", sTagname, sTime, sServer)
        Cells(k, 34).Value = macroResult
        If Cells(k, 34).Value = "No Data" Then
            Cells(k, 34).Value = ""
        End If
    Next
                     
End If

i = 8
b = 1

Do While b <> ""
    b = Cells(i, 35).Value
    i = i + 1
Loop
i = i - 2

If i < j Then
    For k = i + 1 To j
        sTime = Cells(k, 7).Value
        sTagname = Cells(5, 35).Value
        macroResult = Application.Run("PITimeDat", sTagname, sTime, sServer)
        Cells(k, 35).Value = macroResult
        If Cells(k, 35).Value = "No Data" Then
            Cells(k, 35).Value = ""
        End If
    Next
                     
End If

i = 8
b = 1

Do While b <> ""
    b = Cells(i, 36).Value
    i = i + 1
Loop
i = i - 2

If i < j Then
    For k = i + 1 To j
        sTime = Cells(k, 7).Value
        sTagname = Cells(5, 36).Value
        macroResult = Application.Run("PITimeDat", sTagname, sTime, sServer)
        Cells(k, 36).Value = macroResult
        If Cells(k, 36).Value = "No Data" Then
            Cells(k, 36).Value = ""
        End If
    Next
                     
End If

i = 8
b = 1

Do While b <> ""
    b = Cells(i, 37).Value
    i = i + 1
Loop
i = i - 2

If i = j Then MsgBox ("Pas de mise à jour à effectuer")

If i < j Then
    For k = i + 1 To j
        sTime = Cells(k, 7).Value
        sTagname = Cells(5, 37).Value
        macroResult = Application.Run("PITimeDat", sTagname, sTime, sServer)
        Cells(k, 37).Value = macroResult
        If Cells(k, 37).Value = "No Data" Then
            Cells(k, 37).Value = ""
        End If
    Next
             
    ok = MsgBox("opération terminée", vbOKOnly, "Recup PI EP8")
       
End If

If i > j Then MsgBox ("Il manque des dates")

'
End Sub

Ma demande est de m'orienter pour établir une boucle plus simple et peut être moins répétitive...
Merci d'avance pour votre aide.

Cissou
 
Dernière édition:
Trier par date Trier par votes
Re : Simplification de Macro

Bonjour Cissou,

tu dois mettre ceci (et toute la suite)dans une boucle
Code: 
Do While b <> ""
    b = Cells(i, 22).Value
    i = i + 1
Loop
i = i - 2
 
If i < j Then
    For k = i + 1 To j
        sTime = Cells(k, 7).Value
        sTagname = Cells(5, 22).Value
        macroResult = Application.Run("PITimeDat", sTagname, sTime, sServer)
        Cells(k, 22).Value = macroResult
        If Cells(k, 22).Value = "No Data" Then
            Cells(k, 22).Value = ""
        End If
    Next
 
End If
exemple de boucle:
Code: 
[B][COLOR=blue]For f = 22 To 37[/COLOR][/B]
Do While b <> ""
    b = Cells(i, [B][COLOR=blue]f[/COLOR][/B]).Value
    i = i + 1
Loop
i = i - 2
 
If i < j Then
    For k = i + 1 To j
        sTime = Cells(k,[COLOR=black]7[/COLOR]).Value
        sTagname = Cells(5,[B][COLOR=blue] f[/COLOR][/B]).Value
        macroResult = Application.Run("PITimeDat", sTagname, sTime, sServer)
        Cells(k, [B][COLOR=blue]f[/COLOR][/B]).Value = macroResult
        If Cells(k, [COLOR=blue][B]f[/B][/COLOR]).Value = "No Data" Then
            Cells(k, [COLOR=blue][B]f[/B][/COLOR]).Value = ""
        End If
    Next
 
End If
[COLOR=blue][B]Next f[/B][/COLOR]

à+
Philippe
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Simplification de Macro

Bonjour Cissou et phlaurent55,

J'ai rajouté la définition de quelques variables.

Bien sûr sans test on ne peut guère garantir le résultat car la syntaxe est sûrement améliorable.

Sub Recup_PI_EP8()
Dim sTagname As String, Time As String, sServer As String, macroResult As Variant, sTime, Ok As String
Dim a As Date, b As Date, i As Byte, j As Byte, k As Byte, Col As Byte
sServer = "10.125.243.65"

i = 8: j = 8: a = 1: b = 1

' Recherche des dates
Do While a <> ""
a = Cells(j, 7).Value
j = j + 1
Loop
j = j - 2


For Col = 21 To 36
' Recherche des valeurs pour le premier tag
Do While b <> ""
b = Cells(i, 21).Value
i = i + 1
Loop
i = i - 2

If i < j Then
For k = i + 1 To j
sTime = Cells(k, 7).Value
sTagname = Cells(5, 21).Value
macroResult = Application.Run("PITimeDat", sTagname, sTime, sServer)
Cells(k, 21).Value = macroResult
If Cells(k, 21).Value = "No Data" Then
Cells(k, 21).Value = ""
End If
Next

End If

Next Col

Do While b <> ""
b = Cells(i, 37).Value
i = i + 1
Loop
i = i - 2

If i = j Then MsgBox ("Pas de mise à jour à effectuer")

If i < j Then
For k = i + 1 To j
sTime = Cells(k, 7).Value
sTagname = Cells(5, 37).Value
macroResult = Application.Run("PITimeDat", sTagname, sTime, sServer)
Cells(k, 37).Value = macroResult
If Cells(k, 37).Value = "No Data" Then
Cells(k, 37).Value = ""
End If
Next

Ok = MsgBox("opération terminée", vbOKOnly, "Recup PI EP8")

End If

If i > j Then MsgBox ("Il manque des dates")

End Sub
 
Vote positif 0 Vote négatif
Re : Simplification de Macro

Bernard,

ton code est un peu complexe en écriture... et j'avoue ne pas tout comprendre au début...

Philippe,

Ce code me plait mais je ne sais pas comment lui faire afficher une msgbox qui signifie que la boucle a bouclé... car si je la laisse dans la boucle For f ... Next f elle va se répéter 16 fois !!
Or si je la sort de la boucle, est-ce sur que la boucle sera complète ?

Code: 
' Recherche des valeurs pour les tag
i = 8
b = 1

For f = 22 To 37
Do While b <> ""
    b = Cells(i, f).Value
    i = i + 1
Loop
i = i - 2

If i = j Then MsgBox ("Pas de mise à jour à effectuer")

If i < j Then
    For k = i + 1 To j
        sTime = Cells(k, 7).Value
        sTagname = Cells(5, f).Value
        macroResult = Application.Run("PITimeDat", sTagname, sTime, sServer)
        Cells(k, f).Value = macroResult
        If Cells(k, f).Value = "No Data" Then
            Cells(k, f).Value = ""
        End If
    Next
             
    Ok = MsgBox("opération terminée", vbOKOnly, "Recup PI EP8")
       
End If

If i > j Then MsgBox ("Il manque des dates")

Next f
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Simplification de Macro

Re,
Ce code me plait mais je ne sais pas comment lui faire afficher une msgbox qui signifie que la boucle a bouclé... car si je la laisse dans la boucle For f ... Next f elle va se répéter 16 fois !!
Or si je la sort de la boucle, est-ce sur que la boucle sera complète ?
Cliquez pour agrandir...
tu y parviendra facilement avec ceci ( à mettre en fin de boucle avant Next f )

If f = 27 Then
MsgBox("....ton message....")
End If

après avoir relu ton code, il faut "boucler" de 21 à 27 et pas 22 à 27

à+
Philippe
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

J
  • Question Question
Microsoft 365 Userform comboboxes indexés
Réponses
8
Affichages
233
jp26200
J
F
  • Résolu(e)
Autres Insérer une ligne
2 3
Réponses
36
Affichages
2 K
francescofrancesco
F
F
  • Question Question
XL 2021 probleme dans la macro
Réponses
4
Affichages
177
kiki29
kiki29
P
  • Question Question
Microsoft 365 VBA et Segments TCD
Réponses
2
Affichages
201
patricko-13
P
B
  • Question Question
Microsoft 365 Macro pour création fichier csv
Réponses
8
Affichages
466
job75
job75
Electron24
  • Résolu(e)
Microsoft 365 Virgules dans ListView
Réponses
5
Affichages
145
Electron24
Electron24
G
  • Résolu(e)
XL 2016 Pb de tri et sous totaux
2
Réponses
27
Affichages
643
Gestionnaire_rh
G
N
  • Question Question
Listbox click
Réponses
10
Affichages
281
ChTi160
ChTi160
K
  • Résolu(e)
XL 2016 Affichage TextBox
Réponses
6
Affichages
243
KRUG WOO
K
L
  • Question Question
Microsoft 365 Erreur automation 440 sur code VBA
Réponses
1
Affichages
114
job75
job75
T
  • Résolu(e)
Microsoft 365 VBA Exporter une sélection de plages nommées au format PDF
Réponses
12
Affichages
503
tnion
T
cathodique
  • Résolu(e)
XL 2010 Erreur de compilation - Incompatibilité de type: tableau ou type défini par l'utilisateur
Réponses
3
Affichages
322
cathodique
cathodique
C
  • Question Question
Microsoft 365 Comptage cellule avec condition
Réponses
2
Affichages
123
CortoXls
C
S
  • Question Question
XL 2021 Listing Album Panini
Réponses
5
Affichages
232
job75
job75
B
  • Question Question
Autres Problème d'adaptation du contenu d'une listbox
Réponses
7
Affichages
208
jurassic pork
jurassic pork
VBA_dev_Anne_Marie
  • Question Question
Microsoft 365 VBA : copier les adresses
Réponses
7
Affichages
339
VBA_dev_Anne_Marie
VBA_dev_Anne_Marie
C
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
169
CDALE
C
T
  • Résolu(e)
XL 2016 macro et feuille protégé
2
Réponses
18
Affichages
916
laurent950
laurent950
J
  • Question Question
XL 2021 transfert listview vers feuille excel
Réponses
9
Affichages
315
Piment
P
C
  • Question Question
Microsoft 365 worksheet_change
2
Réponses
29
Affichages
479
CortoXls
C
Retour