Discussion :

[nonesofar]

Bonjour à tous,

Je souhaite lorsque j'ai un doublon sur une ligne la supprimer et transposer la valeur en double sur une même ligne.

J'ai récupéré ce code qui fonctionne bien. Mais j'ai un problème de mémoire insuffisante lorsque je lance la macro sur 63 000 lignes.

Pourtant avec la dimension des tableaux je pensais que cela aller m’affranchir de cette contrainte.

Si vous avez une idée plus efficace?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
 
Sub Regroupe()
Dim J As Long
Dim I As Integer
Dim K As Long
Dim Indice As Long
Dim Tablo
Dim Nb As Integer
 
  Application.ScreenUpdating = False
  ReDim Tablo(1 To Range("A" & Rows.Count).End(xlUp).Row - 5, 1 To 2)
  Tablo(1, 1) = Range("A5")
  Tablo(1, 2) = Range("B5")
  Nb = 1
  For J = 6 To Range("A" & Rows.Count).End(xlUp).Row
    For K = 1 To UBound(Tablo)
      If Range("A" & J) = Tablo(K, 1) Then
        For I = 1 To UBound(Tablo, 2)
          If Tablo(K, I) = "" Then
            Tablo(K, I) = Range("B" & J)
            Exit For
          End If
        Next I
        If I > UBound(Tablo, 2) Then
          ReDim Preserve Tablo(1 To UBound(Tablo), 1 To UBound(Tablo, 2) + 1)
          Tablo(K, UBound(Tablo, 2)) = Range("B" & J)
        End If
        Exit For
      ElseIf Tablo(K, 1) = "" Then
        Nb = Nb + 1
        Tablo(K, 1) = Range("A" & J)
        Tablo(K, 2) = Range("B" & J)
        Exit For
      End If
    Next K
  Next J
  With Sheets("Résultat")
    .Cells.ClearContents
    .Range("A2").Resize(Nb, UBound(Tablo, 2)) = Tablo
    .Range("A1") = "Produit"
    .Range("B1") = "Col 1"
    .Range("B1").AutoFill .Range("B1").Resize(, UBound(Tablo, 2) - 1), xlFillSeries
    .Range(.Range("A1"), .Cells(1, UBound(Tablo, 2))).EntireColumn.AutoFit
    .Select
  End With
End Sub

Merci par avance.

[nonesofar]

Pour info, j'ai fait d'autres test à partir de 35000 lignes j'ai mémoire insuffisante.

Etrange

[joe.levrai]

Bonjour,

je ne sais pas si c'est la grosse fatigue qui m'habite ou un petit soucis en regardant tes lignes 11,15 et 16

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
ReDim Tablo(1 To Range("A" & Rows.Count).End(xlUp).Row - 5, 1 To 2)
    For J = 6 To Range("A" & Rows.Count).End(xlUp).Row
        For K = 1 To UBound(Tablo)

ça me paraître être une quantité phénoménale de tour de boucle cette imbrication ? C'est voulu ?
Trop fatigué pour me pencher sur le besoin auquel répond cette procédure, c'est l'heure du dodo on dirait

[nonesofar]

Salut,

Merci d'avoir répondu à mon message.

Ben oui c'est voulu mais en effet cela fait trop de boucle et le programme indique que la mémoire n'est pas suffisante.

J'ai cherché d'autres code pour réaliser le besoin et on passe par des boucles imbriquées aussi.

[joe.levrai]

Bonjour,

peux-tu mettre une copie écran montrant un exemple d'agencement de ta feuille initiale ?

[nonesofar]

Pas de problémes;

Voila deux colonnes, ou je dois pour chaque doublon creer une ligne unique avec en colonnes les doublons.



ça fonctionne bien sauf avec un grand nombre de ligne > 20 000