Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2019 Duplication P fois des lignes ayant le dernier chiffre non vide le plus élevé

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

gthe

XLDnaute Junior
Bonjour !
Je souhaite quelque chose d'assez simple (mais je ne sais pas utiliser VBA 🙁 ).

Soit un tableau de la taille de la feuille Excel entière.
Ce tableau peut contenir des cases vides, mais la première colonne est toujours remplie (si ça peut aider).

Je souhaiterais dupliquer toutes les lignes P fois possédant leur dernière case non vide la plus élevée parmi toutes les valeurs du tableau.

Par exemple :

1 2 3 1 2 3
1 2 1 1 2
1 3 2 1 2 2
1 2 3 1 2 1
1 3 2 1 2 1 2
3 1 2 2 1 3
2 1 3 1 2 3
2 2 1 1 3
2 1 2 3 1 1
1 2 1 1 2 1 3 1 2
2 1 2 1 2 3 3
1 2 2 3 1 1 2

où seules les lignes suivantes seraient dupliquées P fois :

1 2 3 1 2 3
3 1 2 2 1 3
2 1 3 1 2 3
2 2 1 1 3
2 1 2 1 2 3 3

Nota : je peux être susceptible d'être confronté à des tableaux d'un million de lignes, ce serait un gros plus si le programme s'exécute "assez" rapidement.

En vous remerciant infinement,

G.
 

Pièces jointes

Bonjour,
C'est parfait, je vais pouvoir faire de nouveaux tests avec !
Si jamais je ne fais pas de retour, c'est que je considère que c'est OK 😉
Il se peut que je fasse des tests un peu plus poussés, ce qui peut considérablement augmenter mon temps de réponse.
En tout cas merci beaucoup ! 🙂
 
Bonjour gthe, mapomme, le forum,

Dans ce fichier (2) on a le choix entre la feuille "Résultat" et la création du fichier texte "Fichier TXT" :
VB:
Sub FichierTXT()
Dim t#, P&, tablo, maxi#, ncol%, fichier$, i&, j%, dercol%, x$, k&
t = Timer
If [ISERROR(LN(C1))] Then [C1] = 0
P = [C1] 'nombre de copies
tablo = Feuil1.UsedRange.Offset(1) 'matrice, plus rapide
maxi = Application.Max(tablo)
ncol = UBound(tablo, 2)
fichier = ThisWorkbook.Path & "\Fichier TXT.txt" 'à adapter
Open fichier For Output As #1
For i = 1 To UBound(tablo)
    For j = ncol To 1 Step -1
        If tablo(i, j) <> "" Then Exit For
    Next j
    dercol = j
    If dercol Then
        x = ""
        For j = 1 To dercol
            x = x & vbTab & tablo(i, j) 'concaténation
        Next
        x = Mid(x, 2)
        Print #1, x
        If tablo(i, dercol) = maxi Then
            For k = 1 To P
                Print #1, x
            Next k
        End If
    End If
Next i
Close #1
MsgBox "Fichier texte créé en " & Format(Timer - t, "0.00 \sec")
VBA.Shell "notepad.exe " & fichier, vbNormalFocus 'affichage
End Sub
Avec le tableau source de 456 000 lignes le fichier texte est créé en 3 secondes, c'est 2 fois plus rapide.

A+
 

Pièces jointes

Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…