Formule VBA pour faire un copier sur plusieurs lignes

J

juliensav

XLDnaute Junior
Bonjour à tous,

Ce que je veux est indiqué dans mon fichier excel.



Merci
 
Dernière édition:
Trier par date Trier par votes
klin89

klin89

XLDnaute Accro
Re : Formule VBA pour faire un copier sur plusieurs lignes

Bonsoir juliensav,

Comme beaucoup d'entre nous, je me suis penché sur ton problème et essayer de comprendre.

Mais il faut avouer que ce n'est pas vraiment clair.

Veux-tu créer une nomenclature ?

Si oui, fais une recherche avec ce mot et apportes nous plus de précisions.

Amicalement Klin89
 
Vote positif 0 Vote négatif
bqtr

bqtr

XLDnaute Accro
Re : Formule VBA pour faire un copier sur plusieurs lignes

Bonjour tous le monde,

Si j'ai bien compris voici un exemple :

Code: 
Sub Tri()
Dim Tablo, TabCol(), Col, Ck, Ci
Dim x As Long, k As Long, y As Long, m As Long, q As Long, j As Long, n As Long
Set Col = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
With Sheets("famille-produit")
  Tablo = .Range("A2:C" & .Range("A65536").End(xlUp).Row)
 
  For x = 1 To UBound(Tablo)
    If Not Col.Exists(Tablo(x, 3)) Then
       Col.Add Tablo(x, 3), 1
    Else
       temp = Col.Item(Tablo(x, 3))
       Col.Remove Tablo(x, 3)
       Col.Add Tablo(x, 3), temp + 1
    End If
  Next x
  Ck = Col.keys
  Ci = Col.items
  For k = LBound(Ci) To UBound(Ci)
    ReDim Preserve TabCol(1, 1 To k + 1)
    TabCol(0, k + 1) = Ck(k)
    TabCol(1, k + 1) = Ci(k)
  Next
  y = 2
  j = 2
  For m = 1 To UBound(TabCol, 2)
     For q = 1 To UBound(Tablo)
       If TabCol(0, m) = Tablo(q, 3) Then
         .Range("G" & y) = Tablo(q, 1)
         .Range("H" & y) = Tablo(q, 2)
            For n = 1 To UBound(Tablo)
               If Tablo(n, 3) = Tablo(q, 3) Then
                  If Tablo(n, 2) <> Tablo(q, 2) Then
                    .Range("I" & j) = Tablo(n, 2)
                    j = j + 1
                  End If
               End If
            Next
         y = y + (TabCol(1, m) - 1)
       End If
     Next
  Next
 
End With
Application.ScreenUpdating = True
End Sub

Je suis resté sur la 1ère feuille (Colonnes G,H,I) c'est plus facile pour vérifier les résultats. Le traitement se fait en 8-9 secondes (~ 65400 lignes)

Tablo correspond à ta plage de A2 à Cxxx (tableau à 3 colonnes)
Col reprend les élements de la colonne C sans doublon (Keys) et le nombre de doublon pour chaque éléments (Items).
Ck est un tableau avec les élements de Col (Keys).
Ci est un tableau avec les élements de Col (Items), nombre de doublon.
TabCol est un tableau regroupant les Ck et Ci.

Mais attention si tu n'es pas sous Excel 2007 tu seras obligé de couper ta base en deux.
Dans l'exemple que tu as mis, il faut supprimer et mettre ailleurs sur la feuille toutes les lignes après celle-ci
ligne 1558 (13581 - 570-2C-ES - Vanity)
Sinon tu dépasses la limite de la feuille => 65536 lignes.

A+
 
Dernière édition:
Vote positif 0 Vote négatif
J

juliensav

XLDnaute Junior
Re : Formule VBA pour faire un copier sur plusieurs lignes

Merci beaucoup. Tout fonctionne à merveille!!!!! :D

bqtr à dit:
Bonjour tous le monde,

Si j'ai bien compris voici un exemple :

Code: 
Sub Tri()
Dim Tablo, TabCol(), Col, Ck, Ci
Dim x As Long, k As Long, y As Long, m As Long, q As Long, j As Long, n As Long
Set Col = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
With Sheets("famille-produit")
  Tablo = .Range("A2:C" & .Range("A65536").End(xlUp).Row)
 
  For x = 1 To UBound(Tablo)
    If Not Col.Exists(Tablo(x, 3)) Then
       Col.Add Tablo(x, 3), 1
    Else
       temp = Col.Item(Tablo(x, 3))
       Col.Remove Tablo(x, 3)
       Col.Add Tablo(x, 3), temp + 1
    End If
  Next x
  Ck = Col.keys
  Ci = Col.items
  For k = LBound(Ci) To UBound(Ci)
    ReDim Preserve TabCol(1, 1 To k + 1)
    TabCol(0, k + 1) = Ck(k)
    TabCol(1, k + 1) = Ci(k)
  Next
  y = 2
  j = 2
  For m = 1 To UBound(TabCol, 2)
     For q = 1 To UBound(Tablo)
       If TabCol(0, m) = Tablo(q, 3) Then
         .Range("G" & y) = Tablo(q, 1)
         .Range("H" & y) = Tablo(q, 2)
            For n = 1 To UBound(Tablo)
               If Tablo(n, 3) = Tablo(q, 3) Then
                  If Tablo(n, 2) <> Tablo(q, 2) Then
                    .Range("I" & j) = Tablo(n, 2)
                    j = j + 1
                  End If
               End If
            Next
         y = y + (TabCol(1, m) - 1)
       End If
     Next
  Next
 
End With
Application.ScreenUpdating = True
End Sub

Je suis resté sur la 1ère feuille (Colonnes G,H,I) c'est plus facile pour vérifier les résultats. Le traitement se fait en 8-9 secondes (~ 65400 lignes)

Tablo correspond à ta plage de A2 à Cxxx (tableau à 3 colonnes)
Col reprend les élements de la colonne C sans doublon (Keys) et le nombre de doublon pour chaque éléments (Items).
Ck est un tableau avec les élements de Col (Keys).
Ci est un tableau avec les élements de Col (Items), nombre de doublon.
TabCol est un tableau regroupant les Ck et Ci.

Mais attention si tu n'es pas sous Excel 2007 tu seras obligé de couper ta base en deux.
Dans l'exemple que tu as mis, il faut supprimer et mettre ailleurs sur la feuille toutes les lignes après celle-ci
ligne 1558 (13581 - 570-2C-ES - Vanity)
Sinon tu dépasses la limite de la feuille => 65536 lignes.

A+
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif

Discussions similaires

T
  • Résolu(e)
XL 2010 Formule - Copier une formule dans toutes les lignes de la colonne C
Réponses
6
Affichages
116
tchi456
T
S
  • Résolu(e)
XL 2016 VBA pour sélectionner feuilles indiqué dans une cellule
Réponses
6
Affichages
299
sebastien34
S
D
  • Question
Microsoft 365 tri mobile
Réponses
5
Affichages
297
sylvanu
sylvanu
C
  • Question
XL 2013 faire une formule sous Excel 2013 pour copier les mises en forme d'une autre cellule
Réponses
4
Affichages
250
cd92600
C
T
  • Question
Microsoft 365 Query : "un tableau ne peut pas en chevaucher un autre"
Réponses
3
Affichages
199
thenesol
T
F
  • Question
XL 2016 Mise en place d'une macro pour faciliter le remplissage du tableau
Réponses
8
Affichages
220
fd.30
F
C
  • Résolu(e)
XL 2019 Problème d'ajout automatique de lignes à un tableau : la première s'ajoute au tableau mais pas les suivantes !
Réponses
9
Affichages
198
Clemee61
C
L
  • Question
XL 2019 Plusieurs graphes filtrés via un segment
Réponses
0
Affichages
138
link93
L
Yuby
  • Question
XL 2016 Mise en forme conditionnelle pour une date dépassée de 3 ans par rapport à une autre date
Réponses
1
Affichages
272
JHA
J
C
  • Question
XL 2021 Créer une vue filtrée sur plusieurs lignes
Réponses
1
Affichages
157
djidji59430
djidji59430

Membres actuellement en ligne

18 membres et 333 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 345
Messages
2 087 477
Membres
103 555
dernier inscrit
Chtio