Répliquer une ligne sur plusieur sans incrémentation en VBA
Bonjour à toute et tous j'aurais besoin d'un coup de main
Pour excel 2016 j'ai un fichier qui aura beaucoup de colonnes et qui fait facilement 5 à 6000 lignes sur plus d'une 50 aines de colonnes.
Que je vais devoir traiter chaque mois...
Par la suite, J'ai besoin de faire un tris avec les filtres de la mise en forme sous tableau.
Cependant mon tris est impossible à faire si je n'ai pas les lignes de la colonne A à F qui se répliquent (sans incrémentation).
Les lignes vides sont aléatoires et possèdent toutes un trait d'union.
J'aurais besoin que toute la ligne (Jaune de A à F) se réplique sans incrémentation jusqu'au prochain et que le prochain se complète et ainsi de suite.
Vu le nombre de lignes à remplir, étirer ce qui me manque sur 6000 lignes me prend un temps de dingue...
d’où l’importance de pouvoir remplir automatiquement ou avec un bouton les vides (-)
Quelqu'un peut il m'aider pour cela ?
Je vous joint le fichier Excel
Merciii pour votre aide :)
bonsoir,
une proposition via une macro
Sub aargh()
With Sheets("feuil1")
dl = .Cells(Rows.Count, 1).End(xlUp).Row
tb = .Range("A1").Resize(dl, 6)
For i = 1 To dl
If tb(i, 1) = "-" Then
For j = 1 To 6
tb(i, j) = tb(i - 1, j)
Next j
End If
Next i
.Range("A1").Resize(dl, 6) = tb
End With
End Subbonjour Oceanina, salut h2so4,
une autre proposition,
Sub Oceanina()
With Sheets("Feuil1").UsedRange
With .Offset(2).Resize(.Rows.Count - 2) 'à partir de la ligne 3, toutes les lignes
.Replace "-", "", xlWhole 'supprimer les "-"
.SpecialCells(xlBlanks).FormulaR1C1 = "=if(len(R[-1]C),R[-1]C,"""")" 'ajouter une formules aux cellules vides
.Value = .Value 'remplacer formules par leur valeur
End With
End With
End SubHello voici le retour sur les 2 codes que j'ai reçu.
Je n'ai pas réussi à faire fonctionner le 2e code et le premier fonctionne en partie car il transforme mes données de base après la réplication...
Sauf que les Données de bases je ne peux absolument pas y toucher.
Je vous joint un 2e fichier Excel.
(la Page BASE est le fichier de départ il ne peut absolument pas se modifier lors de la réplication. Toutes les données doivent rester "Standard" cad tel que je le reçois).
Merci beaucoup pour votre aide :)
re, la macro "Oceania", MAIS, le vrai problème se pose un moment plus tôt. Je pense que vous avez reçu un fichier TXT ou CSV et que vous l'avez déjà importé dans excel et puis ... . Donnez-nous ce fichier CSV ou TXT (quelque lignes suffit)
Bonjour le fichier n'arrive pas en CSV il m'arrive en version "Classeur Excel 97- 2003(*.xls)"
Ensuite ce que je fais (avant de faire mon tris manuel actuellement) c'est de l’enregistrer dans une version excel plus récente qui accepte les macro.
Le fichier d'orgine arrive avec des nombres qui sont vu par Excel en texte car j'ai un petit triangle rouge sur chaque code et donc les dates n'ont pas de format de date mais un format standard.
C'est un fichier confidentiel je ne peux donc que partager un exemple avec des données anonymisées.
J'ai testé en mettant une valeur aux colonnes 'date entrée - Mise au frigo et Sortie frigo' : La réplication fonctionne beaucoup mieux mais...
Pour la date entrée c'est OK
Pour les 2 autres colonnes comme j'ai du mettre un format et que j'ai des centièmes de secondes... j'ai mettre ceci (Mise au frigo) aaaa-mm-jj hh:mm:ss,00
Dans la mise au foramt personnalisée je ne peux mettre de point Excel refuse j'ai donc du mettre une virgule.
Cependant sur mon fichier d'origine je n'ai pas virgule mais un point ( 2023-11-03 10:10:00.00) d'autre colonnes ont (2023-11-05 12:46:03.245) ... La colonne "Sortie frigo" a plus de chiffres après le point... ce qui va me poser souci car plus loin dans mon fichier j'aurai des date sans virgule mais avec un point... si un autre comparatif dois encore se faire il sera impossible.
Ce fichier après mon traitement aura une 2e destination ou les personnes qui vont le recevoir vont en faire des tableaux dynamiques mais je ne sais pas ce qu'il vont traiter comme données.
Au moment ou j'ai ecris ce message j'ai reçu un autre code qui l'air de fonctionner je dois encore le tester dès que je peux l'ouvrir je le teste et je reviens mettre un feedback.
re,
plus tard, ce n'est que la 2e partie qui vous aurez besoin
Sub Oceanina()
Dim Ar
'PREPARATION = COPIER ET COLLER "BASE"
Sheets("2e code").Cells.Clear
Application.Wait Now + TimeSerial(0, 0, 1)
Sheets("base").Range("A1").CurrentRegion.Copy Sheets("2e code").Range("A1") '.PasteSpecial xlValues
Application.Wait Now + TimeSerial(0, 0, 1)
'LA MACRO ELLE-MEME
Application.ScreenUpdating = False
With Sheets("2e code").UsedRange
.Columns(1).Replace "-", "", xlWhole
For Each Ar In .Columns(1).SpecialCells(xlBlanks).Areas
Ar.Cells(0, 1).EntireRow.Copy Ar
Next
End With
Application.ScreenUpdating = True
End Subre,
Sub Methode2()
aA = Sheets("base").Range("A1").CurrentRegion.Value
For j = 1 To UBound(aA, 2)
For i = 2 To UBound(aA)
If aA(i, j) <> "-" Then
If aA(i, j) Like "##/##/####" Then
sp = Split(aA(i, j), "/")
Valeur = --DateSerial(sp(2), sp(1), sp(0))
ElseIf aA(i, j) Like "####-##-## ##:##:##*" Then
sp = Split(Replace(aA(i, j) & ".000", ".", " "))
Valeur = CDbl((DateValue(sp(0)) + TimeValue(sp(1)) + Left(sp(2), 3) / 86400000))
ElseIf IsNumeric(aA(i, j)) Then
Valeur = "'" & aA(i, j)
Else
Valeur = aA(i, j)
End If
End If
aA(i, j) = Valeur
Next
Next
With Sheets("2e code")
.Cells.Clear
.Range("A1").Resize(UBound(aA), UBound(aA, 2)).Value = aA
.Columns("D").NumberFormat = "dd/mm/yyyy"
.Range("E:F").NumberFormat = "dd/mm/yyyy hh:mm:ss.000"
End With
End Sub
