XL 2010 insertion de ligne et incrémentation

[guytares]

Bonjour dans mon fichier a gauche j"ai 81 url du style

Ce lien n'existe plus et en colonne (B) Ce lien n'existe plus Je voudrais insérer dans la colonne (B) 241 lignes de la forme Ce lien n'existe plus puis page = 2 puis page 3 jusqu'a 241 Puis continuer avec les 80 autres url Merci d'avance

 

[sylvanu]

Bonjour Guytares,
En PJ un essai, si j'ai bien tout compris.
Ca génère 19280 url. C'est pas mal.
La macro est courte et simple :

Sub Insertion()
[B2:B65000].ClearContents
Taille = Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row
IndexColB = 2
For Nlien = 2 To Taille
    Lien = Range("A" & Taille).Value
    tablo = Split(Lien, "=")
    Lien = tablo(0) & "="
    For Npage = 1 To 241
        Range("B" & IndexColB) = Lien & Npage
        IndexColB = IndexColB + 1
    Next Npage
Next Nlien
End Sub

 

[mapomme]

Bonjour à tous,

Une autre macro:

Sub Inserer()
   Dim t, i&, n&, max&, pref
   Columns("b:b").Clear
   Range("b1") = "insert"
   t = Range("a2:a" & Cells(Rows.Count, "a").End(xlUp).Row)
   For i = 1 To UBound(t): n = n + Mid(t(i, 1), InStr(t(i, 1), "=") + 1, 99): Next
   ReDim v(1 To n, 1 To 1): n = 0
   For i = 1 To UBound(t)
      pref = Left(t(i, 1), InStr(t(i, 1), "="))
      max = 1 * Mid(t(i, 1), InStr(t(i, 1), "=") + 1, 99)
      For j = 1 To max: n = n + 1: v(n, 1) = pref & j: Next
   Next i
   Range("b2").Resize(UBound(v)) = v
End Sub

 

[guytares]

Bonjour silvanu et merci pour votre réponse n'est pas bon ce que je veux sur la colonne B pour la premiere ligne c"est

Ce lien n'existe plus

Ce lien n'existe plus

Ce lien n'existe plus

Ce lien n'existe plus

Ce lien n'existe plus

Ce lien n'existe plus

Ce lien n'existe plus

jusqu'a 241

Ce lien n'existe plus

Ce lien n'existe plus

Ce lien n'existe plus

Ce lien n'existe plus

Ce lien n'existe plus

Ce lien n'existe plus

jusqu'a 241

Ce lien n'existe plus

Ce lien n'existe plus

Ce lien n'existe plus

Ce lien n'existe plus

Ce lien n'existe plus

Ce lien n'existe plus

Ce lien n'existe plus

jusqu'a 361

 

[sylvanu]

Oups, petit bug !

 

[guytares]

Bonjour à tous,

Une autre macro:

Sub Inserer()
   Dim t, i&, n&, max&, pref
   Columns("b:b").Clear
   Range("b1") = "insert"
   t = Range("a2:a" & Cells(Rows.Count, "a").End(xlUp).Row)
   For i = 1 To UBound(t): n = n + Mid(t(i, 1), InStr(t(i, 1), "=") + 1, 99): Next
   ReDim v(1 To n, 1 To 1): n = 0
   For i = 1 To UBound(t)
      pref = Left(t(i, 1), InStr(t(i, 1), "="))
      max = 1 * Mid(t(i, 1), InStr(t(i, 1), "=") + 1, 99)
      For j = 1 To max: n = n + 1: v(n, 1) = pref & j: Next
   Next i
   Range("b2").Resize(UBound(v)) = v
End Sub

 

[guytares]

mapomme merci pour ta macro ca marche nickel

 

[guytares]

Oups, petit bug !

Sylvanu c'est mieux mais tu ne fait pas la bonne incrémentation le chiffre n'est pas toujours 241
pour la troisème valeur c'est 361 et pour la quatrième c'est 180

 

[sylvanu]

Désolé.

Je voudrais insérer dans la colonne (B) 241 lignes de la forme Ce lien n'existe plus puis page = 2 puis page 3 jusqu'a 241
Puis continuer avec les 80 autres url Merci d'avance

 

[guytares]

Sylvanu tu doit avoir 4466 resultats

 

[guytares]

Merci à Syvanu et à La pomme vous avez résolu mon probleme

 

[guytares]

Bonjour à tous,

Une autre macro:

Sub Inserer()
   Dim t, i&, n&, max&, pref
   Columns("b:b").Clear
   Range("b1") = "insert"
   t = Range("a2:a" & Cells(Rows.Count, "a").End(xlUp).Row)
   For i = 1 To UBound(t): n = n + Mid(t(i, 1), InStr(t(i, 1), "=") + 1, 99): Next
   ReDim v(1 To n, 1 To 1): n = 0
   For i = 1 To UBound(t)
      pref = Left(t(i, 1), InStr(t(i, 1), "="))
      max = 1 * Mid(t(i, 1), InStr(t(i, 1), "=") + 1, 99)
      For j = 1 To max: n = n + 1: v(n, 1) = pref & j: Next
   Next i
   Range("b2").Resize(UBound(v)) = v
End Sub

Bonjour la pomme tu m'avais fait une super macro en mars 2020, j'ai un petit bug car j'ai changé la liste d'url en A, peus tu m'aider