Résolu insertion d'un nombre variable de données dans une boucle

ninajams

XLDnaute Nouveau
Bonjour,

J'ai commencé une boucle mais je bloque à partir de :

Code:
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''''''''''''''''JUSQUE LA TOUT MARCHE''''''''''''''''''''''''''''''''''''''''''''''''

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Mon objectif est de traiter les lignes présente dans l'onglet tri, à partir de la seconde ligne jusqu'à la dernière ligne. Je ne traite pas la 1ère ligne.
Pour chacune de ces lignes je dois faire un petit traitement qui me permet de récupérer une données exploitable. (cette partie je devrais réussir tout seul)

Pour chacune de ces ligne je dois :
insérer une ligne correspondante dans l'onglet Feuil1(sauf pour la première données qui va utiliser la ligne j d'origine),
coller les données de la ligne J sur les lignes inserer
Ajouter enfin les données de la feuille tri dans la colonne F

Exemple

Feuille 1 ligne j = T-shirt (il n'est présent qu'une fois)
Feuille tri : rouge/bleu/vert 1 couleur sur chaque ligne

résultat désirer:

T-shirtrouge
T-shirt
bleu
T-shirt
vert
T-shirt
autre couleur en fonction du nombre de ligne présent dans la feuille tri

Merci pour votre aide


VB:
   Sub boucle_attribut()

    
  '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
    Set T = Worksheets("tri")
     DL = L.Cells(Application.Rows.Count, "A").End(xlUp).Row   '
       For j = 81 To 81 'test sur la ligne 81
  
    
    adresse_URL = L.Cells(j, 1) '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
  
       attribut = "['id_attribute']='"
       Set Trouve = PlageDeRecherche.Cells.Find(What:=attribut, LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlNext) 'On lance la recherche pour trouver la variable attribut_4_nicotine (enfin une partie seulement du texte)
  
    If Trouve Is Nothing Then
    MsgBox ("erreur")
    End If

   tablo = Trouve.Value
    
    Sheets("tri").Activate
  
    tablo = Split(tablo, attribut)
    For h = 1 To UBound(tablo)
    Cells(h + 1, 1) = tablo(h)
    Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''JUSQUE LA TOUT MARCHE''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'On a donc dans l'onglet tri les cellules colonne 1, ligne 2 à dernière lignes
'Je souhaite que la ligne 2 soit copié dans la colonne 6 sur l'onglet Feuil1 au niveau de la ligne J (de notre boucle)
'et que les lignes suivante soit inserer avec les données qui suivent

'par contre il faudrait (ou pas car vous aurez peut-être une autre idée) pouvoir faire le traitement ligne par ligne car je refait une mise en forme sur chaque ligne

'ci dessous le code qui me permet d'insérer dans la Feuil1 le nombre de ligne correspondant au nombre de ligne à copier.
'tout en copiant le contenu de la ligne d'origine
  Dim m As Long
    m = h - 2
    L.Rows(j).Copy
L.Rows(j + 1).Resize(rowsize:=m).Insert Shift:=xlDown



   'à partir de là je coince. Je pensais définir les cellule à copier dans une variable puis la collé en en (j,6) mais je réussi pas
   Set Ma_Plage = T.Range("A2" & ":A" & h)
   L.Cells(j, 6) = Ma_Plage

   'ces lignes me servent à faire un traitement sur les ligne présente dans l'onglet tri pour récupérer la donnée voulu.
    'place = InStr(Ma_Plage, ",")
   ' stock = Left(Cells(h, 1), place - 1)
        
           Next j
        
      




     MsgBox ("fini")

End Sub
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Bonjour
Les dernières instructions avant JUSQUE LÀ TOUT MARCHE me semblent néanmoins suspectes, dans la mesure où Split renvoie un tableau basé 0 et non pas 1. Donc vous ne bouclez qu'a partir de son second élément, d'indice 1. J'aurais mieux compris For h = 0 To UBound(tablo)
Mais c'est peut être normal, si le séparateur est un texte annonçant ce que vous voulez extraire. Dans ce cas c'est correct si vous voulez inscrire le résultat à partir de la colonne B.
Pour le reste je n'ai rien compris, mais je pourrais toujours vous dire comment je l'écrirais en voyant les donnée et le résultat souhaité correspondant dans un classeur joint.
 
Dernière édition:

ninajams

XLDnaute Nouveau
Bonjour
Les dernières instructions avant JUSQUE LÀ TOUT MARCHE me semblent néanmoins suspectes, dans la mesure où Split renvoie un tableau basé 0 et non pas 1. Donc vous ne bouclez qu'a partir de son second élément, d'indice 1. J'aurais mieux compris For h = 0 To UBound(tablo)
Mais c'est peut être normal, si le séparateur est un texte annonçant ce que vous voulez extraire. Dans ce cas c'est correct si vous voulez inscrire le résultat à partir de la colonne B.
Pour le reste je n'ai rien compris, mais je pourrais toujours vous dire comment je l'écrirais en voyant les donnée et le résultat souhaité correspondant dans un classeur joint.
Bonsoir,

merci d'avoir pris le temps de regarder le code.
En effet je n'affiche pas la première ligne car elle ne sert à rien dans mon cas.
C'est surtout d'un point de vue esthétique que je n'affiche pas la 1ère ligne.

En PJ j'ai mis un fichier exemple.

L'objectif de la macro est de :
remplir la colonne F avec les attributs produits identifier dans la feuille tri
Si il n'y a pas d'attribut, on met simple​
Si attribut, on inscrit le numéro de l'attribut dans la colonne F​
Si plusieurs attribut alors il faut dupliquer la ligne concerné dans la feuil1 et mettre 1 attribut par ligne.​

encore merci
 

Fichiers joints

Dranreb

XLDnaute Barbatruc
C'est la feuille résultat ? htmlCodePage n'est pas connu chez moi, je ne peux pas créer la feuille "code source"
 

ninajams

XLDnaute Nouveau
C'est la feuille résultat ? htmlCodePage n'est pas connu chez moi, je ne peux pas créer la feuille "code source"
Désolé il faut un pack complémentaire pour faire tourner cette macro.
J'ai remis le fichier en ayant fait tourner la macro jusqu'à la partie "JUSQUE LA TOUT MARCHE''

L'onglet code source est créer
Et sur l'onglet trie on a bien les différentes option que je souhaite intégrer dans la feuille 1

merci encore
 

Fichiers joints

ninajams

XLDnaute Nouveau
Dans l'exemple fourni

Onglet code source :
Le code source de l'adresse url situé ligne 4 feuille 1

Onglet trie :

J'ai isolé les attributs couleurs présent dans le code source.
Chaque ligne commence par un numéro d'identification de la couleur.

Dans la 1ère ligne qui commence par 31 nous avons black
Dans la seconde ligne qui commence par 47 nous avons gold
Dans la troisième ligne nous avons 580 et blue

Mon objectif est d’insérer :
les donnée 31 et black dans les colonne F et G de la ligne 5
Les données 47 et gold dans les colonne F et G de la ligne 6 tout en copiant les données de la ligne 5 jusqu'à la colonne E
Les données 580 et blue dans les colonne F et G de la ligne 7 tout en copiant les données de la ligne 5 jusqu'à la colonne E

Dans notre exemple il n'y a rien après la ligne 5 mais il faut partir du principe que la ligne 6 est occupé dans le fichier final

Je remet un fichier exemple. Dans celui-ci j'ai mis le résultat désiré dans la feuil1 au niveau des lignes 5 à 7.
 

Fichiers joints

Dranreb

XLDnaute Barbatruc
N'est-ce pas un peu malaisé de compléter la Feui1 pendant que vous l'explorez ?
Car elle sert aussi de feuille de départ, n'est-ce pas ? Et si vous vous apercevez que vous avez oublié une URL qu'est-ce que vous faites ? Il vaudrait mieux produire le résultat dans une autre feuille
Ce serait bien plus facile et plus rapide de travailler avec des tableaux VBA dynamiques plutôt que par des accès cellule par cellule.
Est-ce qu'un Split direct, sans utiliser de feuille "code source" ne de Find ne marcherait pas ?
Je pense à tablo = Split(htmlCodePage(adresse_URL), attribut)
(avec toujours attribut = "['id_attribute']='")
Ou à la rigueur en décomposant en pas plus de 2 instructions si vous préférez …
Pouvez vous faire l'essai, parce que moi je ne peux pas. À moins que vous me trouviez une référence VBA définissant des objets qui savent faire la même chose. Ça doit exister à mon avis.
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Si ça marche, la procédure pourrait ressembler à ça :
VB:
Option Explicit
Sub SortirAttributs()
   Const TInfIdAttr = "['id_attribute']='", TInfAttrib = "';tabInfos['attribute']='"
   Dim WshRésu As Worksheet, WshDonn As Worksheet, TDon(), LD&, TRés(), LR&, _
      TSp1() As String, TSp2() As String, S&, URL As String, CodeHtml As String
   Set WshDonn = Worksheets("Feuil1")
   Set WshRésu = Worksheets("Feuil2")
   TDon = WshDonn.[A1].CurrentRegion
   ReDim TRés(1 To UBound(TDon, 1) * 10, 1 To 7)
   For LD = 2 To UBound(TDon, 1)
      URL = TDon(L, 1)
      CodeHtml = htmlCodePage(URL)
      TSp1 = Split(CodeHtml, TInfIdAttr)
      If UBound(TSp1) = 0 Then
         LR = LR + 1
         TRés(LR, 1) = TDon(LD, 1)
         TRés(LR, 6) = "simple"
      Else
         For S = 1 To UBound(TSp1)
            TSp2 = Split(TSp1(S), TInfAttrib)
            LR = LR + 1
            TRés(LR, 1) = TDon(LD, 1)
            TRés(LR, 6) = Val(TSp2(0))
            TRés(LR, 7) = Left$(TSp2(1), InStr(TSp2(1), "'") - 1)
            Next S
         End If
      Next LD
   WshRésu.[A2].Resize(UBound(TRés, 1), UBound(TRés, 2)).Value = TRés
   End Sub
À tester …
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Commentez le vous même quitte à me dire ce que vous ne comprenez pas.
Parce que si en plus du code vous avez mes commentaires à comprendre ça fait double travail ;)
Et ne m'en faites pas une longue liste: deux ou trois questions à la fois. D'ailleurs vous pourrez probablement, au bout d'un moment déduire les réponses aux questions suivantes de ce que je vous aurai expliqué plus haut.
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Cette version devrait permettre de remplacer les données par le résultat dans la même feuille, à condition que les URL identiques soient bien ensembles comme dans le premier résultat.
VB:
Sub SortirAttributs()
   Const TInfIdAttr = "['id_attribute']='", TInfAttrib = "';tabInfos['attribute']='"
   Dim WshDonn As Worksheet, WshRésu As Worksheet, TDon(), LD As Long, TRés(), LR As Long, C As Long, _
      URL As String, CodeHtml As String, TSp1() As String, TSp2() As String, S As Long
   Set WshDonn = Worksheets("Feuil1")
   Set WshRésu = Worksheets("Feuil1")
   TDon = WshDonn.[A1].CurrentRegion.Value
   ReDim TRés(1 To UBound(TDon, 1) * 10, 1 To 7)
   For LD = 2 To UBound(TDon, 1)
      If TDon(LD, 1) <> URL Then
         URL = TDon(LD, 1)
         CodeHtml = htmlCodePage(URL)
         TSp1 = Split(CodeHtml, TInfIdAttr)
         If UBound(TSp1) = 0 Then
            LR = LR + 1
            TRés(LR, 1) = URL
            For C = 2 To 5: TRés(LR, C) = TDon(LD, C): Next C
            TRés(LR, 6) = "simple"
         Else
            For S = 1 To UBound(TSp1)
               TSp2 = Split(TSp1(S), TInfAttrib)
               LR = LR + 1
               TRés(LR, 1) = URL
               For C = 2 To 5: TRés(LR, C) = TDon(LR, C): Next C
               TRés(LR, 6) = Val(TSp2(0))
               TRés(LR, 7) = Left$(TSp2(1), InStr(TSp2(1), "'") - 1)
               Next S
            End If
         End If
      Next LD
   WshRésu.[A2].Resize(UBound(TRés, 1), UBound(TRés, 2)).Value = TRés
   End Sub
 
Dernière édition:

ninajams

XLDnaute Nouveau
Re bonsoir,

Autant commencer par les variable parceque je n'en comprend pas une grande partie

VB:
  'on identifie les attributs (numéro et nom) en leur affectant une constante
   Const TInfIdAttr = "['id_attribute']='", TInfAttrib = "';tabInfos['attribute']='"
  
   Dim WshRésu As Worksheet 'je présume qu'il s'agit de l'onglet ou on trouvera le résultat soit ma feuil1
   Dim WshDonn As Worksheet 'je présume qu'il s'agit de l'onglet ou on trouve mes données soit la feuille tri
   Dim TDon() 'la je comprend pas
   Dim LD& '& signifie as long donc je pense que LD représente Derniere Ligne
   Dim TRés() 'la je comprend pas
   Dim LR& 'cela sert à faire une boucle
   Dim TSp1() As String 'la je comprend pas
   Dim TSp2() As String 'la je comprend pas
   Dim S& 'cela sert à faire une boucle
   Dim URL As String
   Dim CodeHtml As String
encore merci
 

Dranreb

XLDnaute Barbatruc
Dim TDon() déclare un tableau dynamique d'éléments de type Variant. Pareil pour TRés.
Non, LD pour moi signifiait le numéro de Ligne courant dans le tableau des Données.
Et LR signifie le numéro de Ligne courant dans le tableau des Résultats
 

ninajams

XLDnaute Nouveau
Dim TDon() déclare un tableau dynamique d'éléments de type Variant. Pareil pour TRés.
Non, LD pour moi signifiait le numéro de Ligne courant dans le tableau des Données.
Et LR signifie le numéro de Ligne courant dans le tableau des Résultats
ok forcément j'était mal partie

VB:
 TDon = WshDonn.[A1].CurrentRegion 'on affecte au tableau dynamique Tdon la cellule A1 de l'onglet WshDonn. Pourquoi ?
 ReDim TRés(1 To UBound(TDon, 1) * 10, 1 To 7) 'la je suis largué
Sur cette partie je comprend pas ce que l'on veut faire
 

Dranreb

XLDnaute Barbatruc
Non, on y affecte la valeur de la région courante contenant la cellule A1
Aïe, ce n'est peut être pas bon si la colonne B est vide. Il vaudrait mieux :
VB:
   TDon = WshDonn.UsedRange.Value
Ou bien :
VB:
   TDon = WshDonn.[A1:E1].Resize(WshDonn.[A1000000].End(xlUp).Row).Value
Redim permet d'attribuer des dimensions à un tableau dynamique, puisque par définition il n'en est pas précisées à sa déclaration.
ReDim TRés(1 To UBound(TDon, 1) * 10, 1 To 7) lui attribue un nombre de lignes de 10 fois le nombre de ligne du tableau de données et de 7 colonnes.
 
Dernière édition:

ninajams

XLDnaute Nouveau
Merci pour le temps passé.
Je pense que je vais devoir bûcher sérieusement sur ce type de code qui est pour l'instant trop complexe pour moi. Je te remercie pour les explications, elles vont m'aider c'est sur ! ;)

J'ai réussi à bricoler un code qui me permet d'obtenir le résultat voulu.

VB:
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 ''''''''''''''''JUSQUE LA TOUT MARCHE''''''''''''''''''''''''''''''''''''''''''''''''
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 

 'ci dessous le code qui me permet d'insérer dans la Feuil1 le nombre de ligne correspondant au nombre de ligne à copier.
 'tout en copiant le contenu de la ligne d'origine
 
  Dim m As Long 'je défini m comme variable qui identifie le nombre de ligne a crée
    m = h - 2 'le nombre de ligne a créer commence seulement à partir de la troisièmre ligne donc je retire 2
    If m = 0 Then 'si je n'ai pas de ligne a créer
    Data = T.Cells(2, 1) 'je séléctionne directement la cellule voulu
     place = InStr(Data, "'") 'je mesure le nombre de caractère jusqu'à atteindre "'"
    stock = Left(Data, place - 1) 'je prend tout ce qui est à gauche de "'". Le -1 permet d'exclure le "'"
    
  L.Cells(j, 6) = stock 'je met mon résultat dans la 6ème colonne
 
  'je refais un traitement pour isolé la couleur et l'inscrire dans la colonne 7
     place1 = InStr(Data, "]='") 'cela me permet de savoir à partir d'ou commencer
     taille = InStr(place1 + 3, Data, "'") 'j'identifie à partir d'ou je dois m'arreter. Le +3 correspond à la taille de "]='"
   stock = Mid(Data, place1 + 3, taille - place1 - 3) 'j'utilise mid pour rechercher dans data, à partir de "]='" (+3 tailles de "]='").
   'Le nombre de caractère est déterminé par valeur de fin -valeur de départ auquel je retire la taille des 3 caractère
   L.Cells(j, 7) = stock 'je met mon résultat dans la 7ème colonne
    
  GoTo suite
  
    Else
   L.Rows(j).Copy
 L.Rows(j + 1).Resize(rowsize:=m).Insert Shift:=xlDown
  DLT = T.Cells(Application.Rows.Count, "A").End(xlUp).Row   '
       For b = 2 To DLT
  Ma_Plage = T.Cells(b, 1)
   place = InStr(Ma_Plage, "'")
   stock = Left(Ma_Plage, place - 1)
 
  L.Cells(j, 6) = stock
 
      place1 = InStr(Ma_Plage, "]='")
     taille = InStr(place1 + 3, Ma_Plage, "'")
   stock = Mid(Ma_Plage, place1 + 3, taille - place1 - 3)
   L.Cells(j, 7) = stock
  If b = DLT Then
  j = j
  Else
  j = j + 1
 End If
  
   Next b
   End If
          
suite:
     Set Trouve = Nothing
     Set PlageDeRecherche = Nothing
  Sheets("code source").Columns(1).ClearContents
    Sheets("tri").Columns(1).ClearContents
  
           Next j
  
     MsgBox ("fini")
  
End Sub
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas