SUPRESSION DE DOUBLON AVEC ADDITION : erreur 6' DEPASSEMENT DE CAPACITE

[PASCAL84810]

Bonjour,

lorsque j’extrais de mon ERP mes lignes de stocks je peux avoir plusieurs lignes pour le même produit.
j'utilise la macro suivante pour n'avoir plus que une ligne par produit.
dans mon exemple joint cela fonctionne bien mais lorsque j'utilise la macro sur le fichier de 10000 LIGNES (il me restera 6000 lignes sans doublon), la macro s’arrête sur la ligne 6947

6947 COSSED06 COSSES POUR EMBOUT DOUBLE DE 2 UN 25 000,00
6948 COSSED06 COSSES POUR EMBOUT DOUBLE DE 2 UN 50 050,00
avec le message suivant : erreur 6' DÉPASSEMENT DE CAPACITÉ

mais cela ne le fait pas dans le fichier réduit en pièce jointe

merci pour votre aide,
PS : la macro est assez longue à d’exécuté, si vous avez plus rapide , je suis preneur

sub suppr_doublons()
Application.ScreenUpdating = False

Dim i, j, k As Integer
Sheets("BASE").Activate

Range("A15000").Select
ActiveCell.FormulaR1C1 = "=COUNTA(R[-14999]C:R[-1]C)"
Range("A15001").Select


j = 1

For i = 2 To Cells(15000, 1).Value

Sheets("BASE").Activate
Cells(i, 1).Select
ActiveCell.EntireRow.Copy
Sheets("BASE PAR ARTICLE").Activate
Cells(j, 1).Select
ActiveCell.EntireRow.PasteSpecial
Sheets("BASE").Activate


While Cells(i, 1) = Cells(i + 1, 1)

k = Cells(i + 1, 4).Value
Sheets("BASE PAR ARTICLE").Activate
Cells(j, 4) = Cells(j, 4) + k

Sheets("BASE").Activate
i = i + 1
Wend
j = j + 1

Next
Application.ScreenUpdating = True

End Sub

 

[Efgé]

Re : SUPRESSION DE DOUBLON AVEC ADDITION : erreur 6' DEPASSEMENT DE CAPACITE

Bonjour PASCAL84810
En utilisant

Dim i, j, k As Integer

tu déclare

Dim i As Variant, j As Variant, k As Integer

De plus Integer est limité à 32 767

Donc utilise :

Dim i As Long, j As Long, k As Long

ou en formulation courte:

Dim i&, j&, k&

Cordialement

 

[PASCAL84810]

Re : SUPRESSION DE DOUBLON AVEC ADDITION : erreur 6' DEPASSEMENT DE CAPACITE

super

merci Efgé,
cela fonctionne parfaitement

cordialement

 

[Paf]

Re : SUPRESSION DE DOUBLON AVEC ADDITION : erreur 6' DEPASSEMENT DE CAPACITE

Bonjour à tous

pour gagner en temps d'exécution, il faut éviter les Select et les Activate qui ralentissement beaucoup.

code modifié en gardant le même algo (temps d'exécution 1s pour 10000 lignes)

Sub suppr_doublons()

Dim i As Integer, j As Integer, k As Long
Dim WS1 As Worksheet, WS2 As Worksheet
Set WS1 = Sheets("BASE")
Set WS2 = Sheets("BASE PAR ARTICLE")

Application.ScreenUpdating = False

WS1.Range("A15000").FormulaR1C1 = "=COUNTA(R[-14999]C:R[-1]C)"

j = 1

For i = 2 To WS1.Cells(15000, 1).Value
    WS1.Cells(i, 1).EntireRow.Copy WS2.Cells(j, 1)
    While WS1.Cells(i, 1) = WS1.Cells(i + 1, 1)
        k = WS1.Cells(i + 1, 4).Value
        WS2.Cells(j, 4) = WS2.Cells(j, 4) + k
        i = i + 1
    Wend
    j = j + 1
Next
Application.ScreenUpdating = True

End Sub

Bonne suite

 

[laetitia90]

Re : SUPRESSION DE DOUBLON AVEC ADDITION : erreur 6' DEPASSEMENT DE CAPACITE

bonjour tous
si on cherche la vitesse il vaut mieux s'orienter sur Dictionary a mon avis !!!
mais pas le temps de construire.....

 

[Efgé]

Re : SUPRESSION DE DOUBLON AVEC ADDITION : erreur 6' DEPASSEMENT DE CAPACITE

RE,
Bonjour Paf
Si on veux aller très vite, après avoir supprimer la formule en $A$15000 (ce qui est une abération à mon avis) et sans avoir à trier les données :

Sub suppr_doublons_3()
Dim i&, J&, K&
Dim T As Variant, DRef As Object, DRow As Object

Set DRef = CreateObject("Scripting.dictionary")
Set DRow = CreateObject("Scripting.dictionary")

With Sheets("BASE")
    T = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(3)(1, 4))
End With

For i = LBound(T, 1) To UBound(T, 1)
    If Not DRef.Exists(T(i, 1)) Then
        K = K + 1
        For J = LBound(T, 2) To UBound(T, 2)
            T(K, J) = T(i, J)
        Next J
        DRef(T(i, 1)) = T(i, 4)
        DRow(T(i, 1)) = K
    Else
        DRef(T(i, 1)) = DRef(T(i, 1)) + T(i, 4)
        T(DRow(T(i, 1)), 4) = DRef(T(i, 1))
    End If
Next i

With Sheets("BASE PAR ARTICLE")
    .UsedRange.Offset(1, 0).ClearContents
    .Cells(2, 1).Resize(K, UBound(T, 2)) = T
End With
End Sub

Cordialement

EDIT
Salut Laetitia

 

[PASCAL84810]

Re : SUPRESSION DE DOUBLON AVEC ADDITION : erreur 6' DEPASSEMENT DE CAPACITE

Bonjour,

merci à tous,

j'ai compris la simplification de Paf et je pourrai l'adapter suivant les cas ou j'en ai besoin , je ne pourrai pas le faire avec Dictionary j'ai déjà du mal à comprendre comme cela.
j'ai mis la formule pour arrêter la macro, sinon par moment elle tourne en boucle.

encore merci à tous

cordialement