Insertion paremetrable d'une ligne (vide) sur deux

rdaniel

XLDnaute Nouveau
Bonjour, :)je souhaiterais insérer une ligne vide toutes les deux lignes dans un tableau contenant un nombre variable de lignes. de 200 à 2500 environ
j'ai bien essayé d'enregistrer une macro mais à la cinquatieme ligne...

Mes connaissance en VBA ne me permette pas (plus):rolleyes:d'automatiser cette tache. j'imagine bien une boucle avec la valeur de répétition saisie dans une boite de dialogue mais je ne peux pas allez plus loin.
Donc l’idéal serait ;
j'ai un tableau de X lignes non vide il faudrait insérer X lignes vides; une entre chaque ligne de données : au final le tableau possède 2X lignes
En vous remerciant de vous intéressez a mon petit projet.
Cordialement :)
Daniel
 

job75

XLDnaute Barbatruc
Bonsoir rdaniel, mapomme,

Si l'on ne traite que des valeurs ceci est très rapide :
VB:
Sub Insertion()
Dim tablo, ncol%, resu(), i&, n&, j%
With Feuil1 'CodeName de la feuille
    tablo = IIf(.UsedRange.Count = 1, .UsedRange.Resize(, 2), .UsedRange)
    ncol = UBound(tablo, 2)
    ReDim resu(1 To 2 * UBound(tablo), 1 To ncol)
    For i = 2 To UBound(tablo)
        If tablo(i, 1) <> "" Then
            n = n + 1
            For j = 1 To ncol
                resu(n, j) = tablo(i, j)
            Next j
        End If
        n = n + 1
    Next i
    '---restitution---
    .[A2].Resize(n, ncol) = resu
End With
End Sub

Sub RAZ()
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCell
With Feuil1.UsedRange
    .Cells(1).EntireColumn.Insert
    .Columns(0) = "=REPT(1,RC[1]<>"""")"
    .Columns(0) = .Columns(0).Value
    Union(.Columns(0), .Cells).Sort .Columns(0), Header:=xlYes 'tri pour accélérer
    Intersect(.Columns(0).SpecialCells(xlCellTypeBlanks).EntireRow, .Cells).Delete xlUp
    .Columns(0).EntireColumn.Delete
End With
End Sub
A+
 

Fichiers joints

Dernière édition:

rdaniel

XLDnaute Nouveau
Bonsoir @rdaniel,

Une piste dans le fichier joint. Le code est dans module1.
:)

Bonjour et merci:)pour votre réponse qui dans son principe se rapproche de mon projet
Pourrais je avoir une boite de dialogue pour indiquez le nombre de lignes a prendre en compte ?
j'ai pu décaler le tableau de la colonne C vers la colonne A et n'utiliser qu'une colonne A (en tout cas je crois que j'ai pu...)
je n'ai pas pu démarrer le tableau en ligne 2.
Merci encore
Cordialement
Daniel
 

rdaniel

XLDnaute Nouveau
Bonsoir rdaniel, mapomme,

Si l'on ne traite que des valeurs ceci est très rapide :
VB:
Sub Insertion()
Dim tablo, ncol%, resu(), i&, n&, j%
With Feuil1 'CodeName de la feuille
    tablo = IIf(.UsedRange.Count = 1, .UsedRange.Resize(, 2), .UsedRange)
    ncol = UBound(tablo, 2)
    ReDim resu(1 To 2 * UBound(tablo), 1 To ncol)
    For i = 2 To UBound(tablo)
        If tablo(i, 1) <> "" Then
            n = n + 1
            For j = 1 To ncol
                resu(n, j) = tablo(i, j)
            Next j
        End If
        n = n + 1
    Next i
    '---restitution---
    .[A2].Resize(n, ncol) = resu
End With
End Sub

Sub RAZ()
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCell
With Feuil1.UsedRange
    .Cells(1).EntireColumn.Insert
    .Columns(0) = "=REPT(1,LEN(RC[1]))"
    .Columns(0) = .Columns(0).Value
    Union(.Columns(0), .Cells).Sort .Columns(0), Header:=xlYes 'tri pour accélérer
    Intersect(.Columns(0).SpecialCells(xlCellTypeBlanks).EntireRow, .Cells).Delete xlUp
    .Columns(0).EntireColumn.Delete
End With
End Sub
A+
merci , excellent parfait problème résolu
je ne sais pas si il y a quelque chose a faire pour marquer resolu
Cordialement
Daniel
 

job75

XLDnaute Barbatruc
Bonjour rdaniel, mapomme, le forum,

J'ai corrigé la macro RAZ() du post #3 :
VB:
    .Columns(0) = "=REPT(1,RC[1]<>"""")"
Bonne journée.
 

Discussions similaires


Haut Bas