Dépassement capacité, quelle est l'erreur ?

A

anber

XLDnaute Occasionnel
Bonjour le Forum,

Ci-joint mon code, j'ai un dépassement de capacité je ne vois pas où j'ai fait l'erreur
Quelqu'un peut-il m'aider à écrire plus simplement mon code
Merci


Sub cam()
Dim NumP As Integer, CptLig As Integer, Cpt As Integer, DerLigne As Integer, lig As Integer, lin As Integer, pas As Integer, pas1 As Integer, ligne As Integer, NBLARG As Integer
Dim cel As Range
Dim C As Worksheet
Dim Feuilles1() As Variant

Application.ScreenUpdating = False

Set C = Sheets("CAM")
If C.Range("A1") <> "" Then
'Mise en tableau des feuilles
Feuilles1 = Array("MOV_PP_SUP75", "MOV_PP_75", "MOV_PP_INF75", "IZOM", "CHE", "MEL", "CHEABT")

For Cpt = 0 To UBound(Feuilles1)
Sheets(Feuilles1(Cpt)).UsedRange.ClearContents
Next

With Sheets("CAM") 'tri CAM
.Range("A1:T" & .Range("A65536").End(xlUp).Row).Sort _
Key1:=.Range("D:D"), Order1:=xlDescending, _
Key2:=.Range("E:E"), Order2:=xlDescending, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

'Import des données dans les feuilles pieces
For Each cel In .Range("A1:A" & .Range("A65536").End(xlUp).Row)
If (cel.Offset(0, 1).Value = "B" Or cel.Offset(0, 1).Value = "C") And cel.Offset(0, 3).Value > 75 Then
.Range(cel, cel.Offset(0, 19)).Copy Sheets("MOV_PP_SUP75").Range("A65536").End(xlUp).Offset(1, 0)
ElseIf (cel.Offset(0, 1).Value = "B" Or cel.Offset(0, 1).Value = "C") And cel.Offset(0, 3).Value = 75 Then
.Range(cel, cel.Offset(0, 19)).Copy Sheets("MOV_PP_75").Range("A65536").End(xlUp).Offset(1, 0)
ElseIf (cel.Offset(0, 1).Value = "B" Or cel.Offset(0, 1).Value = "C") And cel.Offset(0, 3).Value < 75 Then
.Range(cel, cel.Offset(0, 19)).Copy Sheets("MOV_PP_INF75").Range("A65536").End(xlUp).Offset(1, 0)
ElseIf cel.Offset(0, 1).Value = "A" Then
.Range(cel, cel.Offset(0, 19)).Copy Sheets("IZOM").Range("A65536").End(xlUp).Offset(1, 0)
ElseIf cel.Offset(0, 1).Value = "D" Then
.Range(cel, cel.Offset(0, 19)).Copy Sheets("CHE").Range("A65536").End(xlUp).Offset(1, 0)
ElseIf cel.Offset(0, 1).Value = "E" Then
.Range(cel, cel.Offset(0, 19)).Copy Sheets("MEL").Range("A65536").End(xlUp).Offset(1, 0)
ElseIf cel.Offset(0, 1).Value = "G" Then
.Range(cel, cel.Offset(0, 19)).Copy Sheets("CHEABT").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next cel
End With

'Echantillonage
For Cpt = 0 To UBound(Feuilles1)
With Sheets(Feuilles1(Cpt))
.Rows("1:1").Delete Shift:=xlUp 'suppression premiere ligne

'Creation des pas
For Each cel In .Range("D1:D" & .Range("D65536").End(xlUp).Row)
Set deb = cel
Set fin = cel

1 If deb.Row = 1 Then GoTo 2
Set deb = deb.Offset(-1)
If deb <> cel Then Set deb = deb.Offset(1) Else GoTo 1

2 If fin.Row = Rows.Count Then GoTo 3
Set fin = fin.Offset(1)
If fin <> cel Then Set fin = fin.Offset(-1) Else GoTo 2

3 NBLARG = fin.Row - deb.Row + 1

pas1 = NBLARG / 200
pas = Int(pas1) + 1 'entier superieur

lin = 1
For lig = deb.Row To fin.Row Step pas
If lin <= 200 Then .Cells(lig, 21) = lin
lin = lin + 1
Next
Next
'Tri des feuilles
With .Range("A:U")
.Sort Key1:=.Range("D1"), Order1:=xlDescending, _
Key2:=.Range("U1"), Order2:=xlAscending, _
Key3:=.Range("E1"), Order3:=xlDescending, Header:=xlNo
End With
.Columns("U:U").Delete Shift:=xlToLeft 'suppression des numeros compteur colonne U

End With
Next
End If
'Ajout des lignes Code
For Cpt = 0 To UBound(Feuilles1)
With Sheets(Feuilles1(Cpt))
If .Range("A1") <> "" Then
NumP = 1
Call AjoutCode1(Feuille:=Feuilles1(Cpt), ligne:=1, NumP:=NumP)
CptLig = 3
While CptLig < .Range("A65536").End(xlUp).Row + 1
If .Range("C" & CptLig) & .Range("D" & CptLig) <> .Range("C" & CptLig - 1) & .Range("D" & CptLig - 1) Then
NumP = NumP + 1
If NumP = 16 Then
Call AjoutCode_spe1(Feuille:=Feuilles1(Cpt), ligne:=CptLig, NumP:=NumP)
NumP = 0
Else
Call AjoutCode1(Feuille:=Feuilles1(Cpt), ligne:=CptLig, NumP:=NumP)
CptLig = CptLig + 1
End If
End If
CptLig = CptLig + 1
Wend
End If
End With
Next
Call derlig1


Application.ScreenUpdating = True
End Sub

Sub AjoutCode1(ByVal Feuille As String, ligne As Integer, NumP As Integer)
With Sheets(Feuille)
.Rows(ligne).insert
.Range("J" & ligne) = "[P" & NumP & "]"
.Range("K" & ligne) = .Range("C" & ligne + 1) & "X" & .Range("D" & ligne + 1)
.Range("L" & ligne) = .Range("D" & ligne + 1)
.Range("M" & ligne) = 0
.Range("N" & ligne) = 999
.Range("O" & ligne) = .Range("C" & ligne + 1)
End With
End Sub

Sub AjoutCode_spe1(ByVal Feuille As String, ligne As Integer, NumP As Integer)
With Sheets(Feuille)
.Rows(ligne).insert
.Range("J" & ligne) = "[P" & NumP & "]"
.Range("K" & ligne) = "recycl"
.Range("L" & ligne) = 0
.Range("M" & ligne) = 0
.Range("O" & ligne) = .Range("C2")
.Rows(ligne + 1).insert
.Rows(ligne + 1).insert
.Rows(ligne + 1).insert
.Rows(ligne + 1).insert
.Rows(ligne + 1).insert
End With
End Sub

Sub derlig1()

Dim CptLig As Integer, derlig As Integer
Dim Feuilles1() As Variant

Feuilles1 = Array("MOV_PP_SUP75", "MOV_PP_75", "MOV_PP_INF75", "IZOM", "CHE", "MEL", "CHEABT")

For Cpt = 0 To UBound(Feuilles1)
With Sheets(Feuilles1(Cpt))
derlig = .Range("A65536").End(xlUp).Row + 1
For CptLig = 1 To .Range("A65536").End(xlUp).Row
.Range("J" & derlig) = "[P16]"
.Range("K" & derlig) = "recycl"
.Range("L" & derlig) = 0
.Range("M" & derlig) = 0
.Range("O" & derlig) = .Range("C2")
Next
For CptLig = 1 To .Range("A65536").End(xlUp).Row
If .Range("J" & CptLig + 6) = "[P1]" Then
.Range("O" & derlig) = .Range("C" & CptLig + 7)
End If
Next
End With
Next

End Sub
 
Trier par date Trier par votes
C

Compte Supprimé 979

Guest
Re : Dépassement capacité, quelle est l'erreur ?

Bonjour Anber

En général, dépassement de capacité, peut vouloir dire que le type de tes variables est mal définit

Exemple : DerLigne As Integer, lig As Integer

Pour le type Integer, ​
la valeur est comprise entre -32 768 et 32 767
or, les lignes vont jusqu'à 65536 = dépassement de capacité

Tu as des tutos sur ce forum en ce qui concerne les variables et autre

A+
 
Vote positif 0 Vote négatif

Discussions similaires

E
  • Résolu(e)
Microsoft 365 Boucle sur lignes <>0
Réponses
2
Affichages
140
eric72
E
T
  • Question
XL 2021 message si une valeur n'existe pas
Réponses
6
Affichages
397
target
T
D
  • Question
XL 2010 Identification d'une cellule cliquée
Réponses
6
Affichages
312
dadu35
D
M
  • Question
Microsoft 365 modifier un code
Réponses
1
Affichages
233
Dranreb
Dranreb
S
  • Résolu(e)
Microsoft 365 Récupérer la date dans un calendrier
Réponses
2
Affichages
90
sebastien176
S
U
  • Question
Autres Enregistrer sur Onglet TOTO
Réponses
2
Affichages
372
un internaute
U
D
  • Question
XL 2010 Valoriser cellule par clic
Réponses
4
Affichages
191
fanch55
fanch55
B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
203
Compte Supprimé 979
C
F
  • Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
163
Francky79
F
T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
883
thivame
T

Membres actuellement en ligne

8 membres et 109 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 084
Messages
2 085 190
Membres
102 809
dernier inscrit
Sandrine83