XL 2010 insertion de ligne et incrémentation

guytares

XLDnaute Nouveau
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
 

Pièces jointes

  • lienexel.xlsx
    13.6 KB · Affichages: 7

sylvanu

XLDnaute Barbatruc
Supporter XLD
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 :
VB:
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
 

Pièces jointes

  • lienexel(2).xlsm
    19.8 KB · Affichages: 7

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour à tous,

Une autre macro:
VB:
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
 

Pièces jointes

  • guytares- lienexel- v1.xlsm
    21.2 KB · Affichages: 7

guytares

XLDnaute Nouveau
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
 

guytares

XLDnaute Nouveau
Bonjour à tous,

Une autre macro:
VB:
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

XLDnaute Nouveau
Bonjour à tous,

Une autre macro:
VB:
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
 

Pièces jointes

  • macrolapomme.xlsm
    38.8 KB · Affichages: 3

Discussions similaires

Statistiques des forums

Discussions
311 709
Messages
2 081 769
Membres
101 816
dernier inscrit
Jfrcs