Macro à améliorer

ninajams

XLDnaute Junior
Bonjour,

J'ai réalisé cette macro qui fonctionne très bien en exploitant des bribes de code ici et là. Vous avez aussi contribuez en m'aidant sur le forum.
Mais j'ai du rajouter pas mal de goto. D'après les messages que j'ai lu sur le forum il faut éviter.

Pouvez vous regarder le code et me donner des pistes d'améliorations ?
Pour ma part je planche déjà sur une seconde version qui fait les recherche directement sur une page html plutôt que de spliter les données sur un onglet.

Merci pour votre temps.

VB:
Sub Mise_a_jour_disponibilité()

  vchrono = Now() 'pour mesurer la durée de la macro
    
  Application.ScreenUpdating = False 'on désactive l'affichage
 
  'Définition des variable
  Dim L As Worksheet, C As Worksheet, adresse_URL As String, attribut As String
  Dim Trouve As Range, PlageDeRecherche As Range
  Dim disponible As String, DL As Integer, j As Integer, indisponible As String, tablo
  Dim Cpt As Integer, CptSh As Integer
    
  'vérification que l'onglet code source existe sinon création
 
    Cpt = 0
    CptSh = Sheets.Count
    For i = 1 To CptSh
        If Sheets(i).Name <> "code source" Then Cpt = Cpt + 1 Else Exit For
    Next i
        If Cpt = CptSh Then
        Sheets.Add.Name = "code source"
    End If
 
   'vérification que l'onglet tri existe sinon création
  Cpt = 0
    CptSh = Sheets.Count
    For i = 1 To CptSh
        If Sheets(i).Name <> "tri" Then Cpt = Cpt + 1 Else Exit For
    Next i
        If Cpt = CptSh Then
        Sheets.Add.Name = "tri"
    End If
    
   'Affectation de valeur aux variable
    
    Set L = Worksheets("Feuil1") 'Je définie mon onglet Feuil1 par L
    Set C = Worksheets("code source") 'Je définie mon onglet code source par C
    DL = L.Cells(Application.Rows.Count, "C").End(xlUp).Row   ' on calcul la dernière ligne non vide
        
   'Début de la boucle
    For j = 2 To DL
    
    adresse_URL = L.Cells(j, 3) 'L'adresse URL se trouve dans la feuille L (liste)
    codeHtml = htmlCodePage(adresse_URL) 'j'affecte ma variable adresse_URL a ce petit boût de code qui necessite un pack complémentaire pour fonctionner
    Sheets("code source").Activate 'J'active la feuille ou je veux les données
    
    codeHtml = Split(codeHtml, Chr(10)) 'Division par ligne de code
    For i = 0 To UBound(codeHtml) 'je ne comprend pas cette partie du code
        Cells(i + 1, 1) = codeHtml(i) 'je ne comprend pas cette partie du code
    Next 'je ne comprend pas cette partie du code
    
    'résultat je me retrouve avec le code source sur l'onglet code source et je peux lancer ma recherche
    
    Set PlageDeRecherche = Sheets("code source").Columns(1) 'on définit la plage de recherche : onglet code source, colonne 1
    emotion_stock = "<input type=""hidden"" id=""prodquantity"" value=""" 'j'affecte une valeur à la variable emotion_stock


If L.Cells(j, 3) Like "*grossisteecigarette.fr*" Then 'Première condition : je vérifie que les url contiennent le texte de la condition
Set Trouve = PlageDeRecherche.Cells.Find(What:=emotion_stock, LookIn:=xlValues, LookAt:=xlPart) 'On lance la recherche pour trouver la variable emotion_stock (enfin une partie seulement du texte)

    If Trouve Is Nothing Then 'second if
      L.Cells(j, 11) = "ARRET"

    Else 'second else
      milieu = Len(Trouve.Value) - 50 'permet le calcul de mid
      stock = Mid(Trouve.Value, 47, milieu) 'permet d'extaire la quantité en stock
      L.Cells(j, 11) = stock
      GoTo ligneSuivante
    
    End If 'fermeture du second if
  
 Else
 GoTo suite
 End If 'fermeture du 1er if
    
suite:

    disponible = "<span id=""availability_value"" class=""available"">" 'il s'agit de la variable qui est présente si le produit est disponible
    indisponible = "<span id=""availability_value"" class=""outofstock"">"   'il s'agit de la variable qui est présente si le produit n'est pas disponible
    
    If L.Cells(j, 10) = "simple" Then
    Set Trouve = PlageDeRecherche.Cells.Find(What:=disponible, LookIn:=xlValues, LookAt:=xlPart) 'On lance la recherche pour trouver la variable disponible (enfin une partie seulement du texte)
 
        If Trouve Is Nothing Then
        Set Trouve = PlageDeRecherche.Cells.Find(What:=indisponible, LookIn:=xlValues, LookAt:=xlPart) 'On lance la recherche pour trouver la variable disponible (enfin une partie seulement du texte)
  
            If Trouve Is Nothing Then
            L.Cells(j, 11) = 0
            L.Cells(j, 12) = "ARRET"
            GoTo ligneSuivante
                        Else
            L.Cells(j, 11) = 0 'le résultat lorsque tout marche
            GoTo ligneSuivante
            End If
 
        Else
        L.Cells(j, 11) = 10 'le résultat lorsque tout marche
        GoTo ligneSuivante
        End If
    Else
    GoTo suite1
    End If

suite1:
    attribut = "new Array('" & L.Cells(j, 10) & "')," 'On affecte à la variable attribut_4_nicotine la valeur recherché qui est composé des élément situé dans la colonne F via k"
    Set Trouve = PlageDeRecherche.Cells.Find(What:=attribut, LookIn:=xlValues, LookAt:=xlPart) 'On lance la recherche pour trouver la variable attribut_4_nicotine (enfin une partie seulement du texte)
    
    If Trouve Is Nothing Then
    L.Cells(j, 11) = 0
    L.Cells(j, 12) = "ARRET"
    GoTo ligneSuivante
    End If
  
   tablo = Trouve.Value
      
    Sheets("tri").Activate
    
    tablo = Split(tablo, attribut)
    For h = 0 To UBound(tablo)
    Cells(h + 1, 1) = tablo(h)
    Next
    
    place = InStr(Cells(2, 1), ",")
    stock = Left(Cells(2, 1), place - 1)
    
    L.Cells(j, 11) = stock

ligneSuivante:

    Set Trouve = Nothing
    Set PlageDeRecherche = Nothing
    Sheets("code source").Columns(1).ClearContents
    
     Next j
    
     L.Cells(1, 11) = "Stock"
    
      Application.ScreenUpdating = True
      
      vchrono = Now() - vchrono
      MsgBox Format(vchrono, "hh:mm:ss:") & Right(Format(Timer, "#0.00"), 2)   
  
End Sub
 

Pounet95

XLDnaute Occasionnel
Bonjour,
J'ai mis le code " à ma façon "
Tester pour voir si ça convient

VB:
'-----------------------------------------------------------------------------------
' J'ai indenté le code " à ma façon " pour, je pense plus de lisibilité
'
' J'ai remplacé le Goto Ligne_Suivante par une procédure du même nom
' Les autres Goto suite ne servaient à rien je les ai laissés mais en commentaire
'
' Je pense que ça devrait convenir
'
'Pounet95
'-----------------------------------------------------------------------------------

Option Explicit         ' déclarer les variables utilisées. Message d'erreur si omis

Sub Mise_a_jour_disponibilité_Modifié()
    'Définition des variable
    Dim L                   As Worksheet
    dim                     As Worksheet
    Dim adresse_URL         As String
    Dim attribut            As String
    Dim Trouve              As Range
    Dim PlageDeRecherche    As Range
    Dim disponible          As String
    DL                      As Integer
    Dim j                   As Integer
    Dim indisponible        As String
    Dim tablo
    Dim Cpt                 As Integer
    Dim CptSh               As Integer

    vchrono = Now() 'pour mesurer la durée de la macro
    
    Application.ScreenUpdating = False 'on désactive l'affichage
 
  'vérification que l'onglet code source existe sinon création
 
    Cpt = 0
    CptSh = Sheets.Count
    For i = 1 To CptSh
        If Sheets(i).Name <> "code source" Then Cpt = Cpt + 1 Else Exit For
    Next i
    If Cpt = CptSh Then
        Sheets.Add.Name = "code source"
    End If
 
   'vérification que l'onglet tri existe sinon création
    Cpt = 0
    CptSh = Sheets.Count
    For i = 1 To CptSh
        If Sheets(i).Name <> "tri" Then Cpt = Cpt + 1 Else Exit For
    Next i
    If Cpt = CptSh Then
        Sheets.Add.Name = "tri"
    End If
    
   'Affectation de valeur aux variable
    
    Set L = Worksheets("Feuil1") 'Je définie mon onglet Feuil1 par L
    Set C = Worksheets("code source") 'Je définie mon onglet code source par C
    DL = L.Cells(Application.Rows.Count, "C").End(xlUp).Row   ' on calcul la dernière ligne non vide
        
   'Début de la boucle
    For j = 2 To DL
    
        adresse_URL = L.Cells(j, 3) 'L'adresse URL se trouve dans la feuille L (liste)
        codeHtml = htmlCodePage(adresse_URL) 'j'affecte ma variable adresse_URL a ce petit boût de code qui necessite un pack complémentaire pour fonctionner
        Sheets("code source").Activate 'J'active la feuille ou je veux les données
    
        codeHtml = Split(codeHtml, Chr(10)) 'Division par ligne de code
        For i = 0 To UBound(codeHtml) 'je ne comprend pas cette partie du code
            Cells(i + 1, 1) = codeHtml(i) 'je ne comprend pas cette partie du code
        Next 'je ne comprend pas cette partie du code
    
        'résultat je me retrouve avec le code source sur l'onglet code source et je peux lancer ma recherche
    
        Set PlageDeRecherche = Sheets("code source").Columns(1) 'on définit la plage de recherche : onglet code source, colonne 1
        emotion_stock = "<input type=""hidden"" id=""prodquantity"" value=""" 'j'affecte une valeur à la variable emotion_stock


        If L.Cells(j, 3) Like "*grossisteecigarette.fr*" Then 'Première condition : je vérifie que les url contiennent le texte de la condition
            Set Trouve = PlageDeRecherche.Cells.Find(What:=emotion_stock, LookIn:=xlValues, LookAt:=xlPart) 'On lance la recherche pour trouver la variable emotion_stock (enfin une partie seulement du texte)

            If Trouve Is Nothing Then 'second if
                L.Cells(j, 11) = "ARRET"

            Else 'second else
                milieu = Len(Trouve.Value) - 50 'permet le calcul de mid
                stock = Mid(Trouve.Value, 47, milieu) 'permet d'extaire la quantité en stock
                L.Cells(j, 11) = stock
                Ligne_Suivante
                '-----------------
                'GoTo ligneSuivante remplacé par l'appel à la Procédure nommée Ligne_Suivante
                '------------------
                Ligne_Suivante
            End If 'fermeture du second if
        '-----------------------------
        'Else
            'GoTo suite     Ces lignes ne servent à rien puisque le code qui suit le End If est éxécuté
            '               de toute façon !
        '--------------------------
        'suite:
        '--------------------------
        End If              'fermeture du 1er if
        
        disponible = "<span id=""availability_value"" class=""available"">" 'il s'agit de la variable qui est présente si le produit est disponible
        indisponible = "<span id=""availability_value"" class=""outofstock"">"   'il s'agit de la variable qui est présente si le produit n'est pas disponible
    
        If L.Cells(j, 10) = "simple" Then
            Set Trouve = PlageDeRecherche.Cells.Find(What:=disponible, LookIn:=xlValues, LookAt:=xlPart) 'On lance la recherche pour trouver la variable disponible (enfin une partie seulement du texte)
 
            If Trouve Is Nothing Then
                Set Trouve = PlageDeRecherche.Cells.Find(What:=indisponible, LookIn:=xlValues, LookAt:=xlPart) 'On lance la recherche pour trouver la variable disponible (enfin une partie seulement du texte)
                If Trouve Is Nothing Then
                    L.Cells(j, 11) = 0
                    L.Cells(j, 12) = "ARRET"
                    '-----------------
                    'GoTo ligneSuivante remplacé par l'appel à la Procédure nommée Ligne_Suivante
                    '
                    Ligne_Suivante
                Else
                    L.Cells(j, 11) = 0 'le résultat lorsque tout marche
                    '-----------------
                    'GoTo ligneSuivante remplacé par l'appel à la Procédure nommée Ligne_Suivante
                    '
                    Ligne_Suivante
                End If
            Else
                L.Cells(j, 11) = 10 'le résultat lorsque tout marche
                    '-----------------
                    'GoTo ligneSuivante remplacé par l'appel à la Procédure nommée Ligne_Suivante
                    '
                    Ligne_Suivante
            End If
        '---------------
        'Else
        '    GoTo suite1        Ces lignes ne servent à rien puisque le code qui suit le End If est éxécuté
        'End If                 de toute façon !
        '---------------
        'suite1:
        '---------------
        attribut = "new Array('" & L.Cells(j, 10) & "')," 'On affecte à la variable attribut_4_nicotine la valeur recherché qui est composé des élément situé dans la colonne F via k"
        Set Trouve = PlageDeRecherche.Cells.Find(What:=attribut, LookIn:=xlValues, LookAt:=xlPart) 'On lance la recherche pour trouver la variable attribut_4_nicotine (enfin une partie seulement du texte)
    
        If Trouve Is Nothing Then
            L.Cells(j, 11) = 0
            L.Cells(j, 12) = "ARRET"
            '-----------------
            'GoTo ligneSuivante remplacé par l'appel à la Procédure nommée Ligne_Suivante
            '
            Ligne_Suivante
        End If
 
        tablo = Trouve.Value
      
        Sheets("tri").Activate
    
        tablo = Split(tablo, attribut)
        For h = 0 To UBound(tablo)
            Cells(h + 1, 1) = tablo(h)
        Next
    
        place = InStr(Cells(2, 1), ",")
        stock = Left(Cells(2, 1), place - 1)
    
        L.Cells(j, 11) = stock
    
        '---------------
        'ligneSuivante:   remplacé par l'appel à la Procédure nommée Ligne_Suivante
        '---------------
        Ligne_Suivante
     Next j
    
     L.Cells(1, 11) = "Stock"
    
    Application.ScreenUpdating = True
      
    vchrono = Now() - vchrono
    MsgBox Format(vchrono, "hh:mm:ss:") & Right(Format(Timer, "#0.00"), 2)
End Sub


Sub Ligne_Suivante()
    Set Trouve = Nothing
    Set PlageDeRecherche = Nothing
    Sheets("code source").Columns(1).ClearContents
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
298 001
Messages
1 965 031
Membres
200 810
dernier inscrit
lejibe