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

  • Initiateur de la discussion Initiateur de la discussion PASCAL84810
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

PASCAL84810

XLDnaute Junior
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
 

Pièces jointes

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

Bonjour PASCAL84810
En utilisant
VB:
Dim i, j, k As Integer
tu déclare
VB:
Dim i As Variant, j As Variant, k As Integer

De plus Integer est limité à 32 767

Donc utilise :
VB:
Dim i As Long, j As Long, k As Long
ou en formulation courte:
VB:
Dim i&, j&, k&

Cordialement
 
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)

Code:
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
 
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 :

VB:
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 🙂
 
Dernière édition:
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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
57
Affichages
5 K
Réponses
68
Affichages
8 K
Retour