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é

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

  • exemple.xlsx
    11.1 KB · Affichages: 36

gthe

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

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

  • exemple(2).xlsm
    34.3 KB · Affichages: 9
Dernière édition:

Discussions similaires

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