Dupliquer lignes selon un critère

Bonjour à tous,

Je suis novice en Excel - VBA. J'aimerai répondre à une problématique personnelle, voici pourquoi j'effectue cette demande.

En effet, j'ai pour chaque ligne un code article, une date, une heure de début et une heure de fin. J'ai identifié les présence de l'article dans chaque créneau horaire (représenté par 24 colonnes de 0 à 23) par un "x". J'aimerai pouvoir dupliquer chaque ligne le nombre de fois qu'elle est présente sur un créneau horaire avec une colonne qui mentionnerait ce créneau horaire.

Je vous joins mon fichier, avec la BDD et le résultat désiré.

Je vous remercie d'avance pour le temps passé.

Bonsoir BenPnL27, le forum,

A tester....

Sub test()
 Dim i%, k%, j%
 Dim tablo, tabloR(), titres

  With Sheets("BDD")
    tablo = .Range("A2").CurrentRegion
   titres = Array("Code article", "Jour", "Heure début", "Heure fin", "Tranche horaire")
     k = 0
      For i = 2 To UBound(tablo, 1)
       For j = 5 To 29
         ReDim Preserve tabloR(1 To 5, 1 To k + 1)
           If UCase(tablo(i, j)) = UCase("x") Then
            tabloR(1, k + 1) = tablo(i, 1)
            tabloR(2, k + 1) = tablo(i, 2)
            tabloR(3, k + 1) = tablo(i, 3)
            tabloR(4, k + 1) = tablo(i, 4)
            tabloR(5, k + 1) = tablo(1, j)
            k = k + 1
           End If
       Next j
      Next i
       On Error Resume Next
        With Sheets("test")
         .Cells.ClearContents
         .Range("A1").Resize(1, 5) = titres: .Range("A1").Resize(1, 5).Font.Bold = True
         .Range("A2").Resize(UBound(tabloR, 2), 5) = Application.Transpose(tabloR)
         .Columns.AutoFit
         .Select
        End With
       Erase tabloR: Erase tablo: Erase titres
  End With
End Sub
  • Code à placer dans un module standard
  • Macro à associer à un bouton
    5benpnl27.xlsm (21.53 Ko)

Cordialement,

Merci beaucoup pour la réactivité xorsankukai,

Le code m'a l'air de bien fonctionner, il faut que je le teste sur ma base de données un peu plus complexe, j'aurai peut-être quelques modifications à faire car j'aurai, je pense, une contrainte supplémentaire. Je reviendrai vers vous pour confirmer tout ça.

Encore merci et bonne soirée.

Bonsoir

Une autre proposition.

Merci pour ta proposition yal_excel,

J'en reviens à ta proposition xorsankukai, celle-ci fonctionne bien sur ma BDD dans l'idée, mais ma BDD est trop grande, 68000 lignes environ. J'ai un message de dépassement de capacité qui apparaît à ce niveau. Que me conseilles-tu ?

image

Merci encore,

Bonjour

La version qui traite 70000 lignes en moins de 7 secondes

Le bouton "Construit base lance une macro qui construit la base de 70000 lignes par duplication des données d'origine

Merci yal_excel,

Cependant, autant votre premier code marchait, autant maintenant il y a une seul ligne qui apparaît dans le résultat avec la tranche horaire du début :

image

Bonjour à tous,

J'en reviens à ta proposition xorsankukai, celle-ci fonctionne bien sur ma BDD dans l'idée, mais ma BDD est trop grande, 68000 lignes environ. J'ai un message de dépassement de capacité qui apparaît à ce niveau. Que me conseilles-tu ?

J'ai déclaré mes variables en Integer(%) , la limite est à 32767, en les déclarant en Long (&), la limite est à 2'147'483'647....et devait corriger le problème...

Dim i&, k&, j&

Cordialement,

Rechercher des sujets similaires à "dupliquer lignes critere"