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

[gthe]

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.

 

[gthe]

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 !

 

[job75]

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" :

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+

 

[gthe]

Salut job75,
Désolé pour ma réponse tardive mais je viens de tester ton nouveau programme !
C'est super, ça marche très bien merci