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.