depassement de capacité

hobine

XLDnaute Nouveau
Bonjour,
J'ai un soucis avec mon programme.
J'ai fait une macro dans excel 2003, elle fonctionne bien seulement dans un cas.
Losrque j'utilise moins de lignes de ma feuille excel2003[/B] (par exple : 15000 Lignes) , ma macro fonctionne , mais dès que j'utilise plus 50000 lignes, elle me met un message d'erreur 6 comme quoi il y a depassement de la capacite.
Comment faire pour faire marcher ma macro au delà de 50000 lignes(A3: DQ50000)?
Vous trouverez mon programme en dessous
merci d'avance

Sub PM_H79_UNI()
'
' PM_H79_UNI Macro
' Macro enregistrée le 08/03/2011 par p059426
'
' Touche de raccourci du clavier: Ctrl+Maj+P
'
Dim tableau(), Result(), grp_nb() As String
Dim Tableau_PM_H79() As Variant, Tableau_VCD_H79() As Variant
Dim Tableau_lignes_PM() As String
Dim line_list_new() As Integer, line_list_old() As Integer, list_ligne() As Integer
Dim tab_crit_grp() As Variant, tab_crit_pm() As Variant
Dim tab_crit_VCD()
Dim tab_projet() As String, tab_semaine() As String
Dim tab_semaine_1() As String
Dim Tableau_sans_zero_Q1() As Double, Tableau_sans_zero_Q2() As Double, Tableau_sans_zero_Q3() As Double
Dim Tableau_cinq_jours_Q1() As Double, Tableau_cinq_jours_Q2() As Double, Tableau_cinq_jours_Q3() As Double
Dim Tableau_sans_zero_Q1_VCD() As Double, Tableau_sans_zero_Q2_VCD() As Double, Tableau_sans_zero_Q3_VCD() As Double
Dim Tableau_cinq_jours_Q1_VCD() As Double, Tableau_cinq_jours_Q2_VCD() As Double, Tableau_cinq_jours_Q3_VCD() As Double
Dim Tableau_moy_lis_Q1() As Double, Tableau_moy_lis_Q2() As Double, Tableau_moy_lis_Q3() As Double
Dim Tableau_moy_lis_Q1_VCD() As Double, Tableau_moy_lis_Q2_VCD() As Double, Tableau_moy_lis_Q3_VCD() As Double
Dim dim_list_line(18) As Integer
' tu sais que cette table aura 52 semaine et qu'elle sera composée de nombres entiers que tu vas manipuler
Dim tab_som_sem(52) As Integer, tab_som_sem_VCD(52) As Integer
' quantités pas quatrimestres
Dim vol_quad(3) As Double, vol_quad_VCD(3) As Double
Dim correspondance_grp() As String, correspondance_pm() As String
Dim correspondance_grp_2() As String, correspondance_VCD() As String
Dim OcQuad_Q1 As Double, maxLS_Q1 As Integer, OcQuad_Q2 As Double, maxLS_Q2 As Integer, OcQuad_Q3 As Double, maxLS_Q3 As Integer
Dim OcQuad_Q1_VCD As Double, maxLS_Q1_VCD As Integer, OcQuad_Q2_VCD As Double, maxLS_Q2_VCD As Integer, OcQuad_Q3_VCD As Double, maxLS_Q3_VCD As Integer

Dim num_ligne As Integer
Dim tmp As Integer
Dim test_tmp As String, s As String
Dim alphabet(2) As String
Dim Plage As Range
Dim stmp As String
Dim n_projet As Integer, moy As Double
Dim n_lignes, n_col As Integer
Dim n_lignes_VCD, n_col_VCD As Integer
Dim ncount, ncount0 As Integer
Dim nb_crit_grp As Integer
Dim nl, lg, ndim, ndim1, ndim2, ndim3, ndim4, ndim5, ndim6, ndim7, ndim8, ndim9 As Integer
Dim ligne_nb As Integer, ndim_count As Integer
Dim i As Integer, j As Integer, m As Integer, l As Integer, n As Integer, n_semaine As Integer
Dim flag As Integer




Sheets("New_Groupement").Select

' Set Plage = Range("D4:T" & Range("B65536").End(xlUp).Row)
Set Plage = Range("C4:U" & Range("B65536").End(xlUp).Row + 1)
tableau = Plage.Value

nl = UBound(tableau, 1)
ncount = 0
For i = 1 To nl
If ((tableau(i, 1) = "X") Or (tableau(i, 1) = "x")) Then
ncount = ncount + 1
End If
Next i


tab_crit_grp = Range("D3:U3").Value




ReDim grp_nb(ncount)

ncount0 = 0
For i = 1 To nl
If ((tableau(i, 1) = "X") Or (tableau(i, 1) = "x")) Then
ncount0 = ncount0 + 1
grp_nb(ncount0) = i
End If
Next i


' assignation des valeurs de la feuille PM_2011_H79 dans le tableau Tableau_PM_H79
Sheets("PM_2011_H79").Select

tab_crit_pm = Range("E3:DP3").Value


' créer les correspondances entre les colones des groupements et les colonnes des PM.
nb_crit_grp = UBound(tab_crit_grp, 2)
nb_crit_pm = UBound(tab_crit_pm, 2)
ReDim correspondance_grp(nb_crit_grp)
ReDim correspondance_pm(nb_crit_grp)
For i = 1 To nb_crit_grp
flag = 0
For j = 1 To nb_crit_pm
If tab_crit_grp(1, i) = tab_crit_pm(1, j) Then
correspondance_grp(i) = i
correspondance_pm(i) = j
flag = 1

End If
Next j
If flag <> 1 Then
' MsgBox "attention, le critere suivant n'existe pas dans la pm:"
'MsgBox tab_crit_grp(1, i)
'MsgBox "ne sélectionnez pas ce critère dans le groupement"
correspondance_grp(i) = 0
correspondance_pm(i) = 0

End If



Next i


Set Plage = Range("A4:DQ" & Range("A65536").End(xlUp).Row + 1)


Tableau_PM_H79 = Plage.Value

n_lignes = UBound(Tableau_PM_H79, 1)
n_col = UBound(Tableau_PM_H79, 2)
For l = 1 To ncount
lg = grp_nb(l)
' à chaque ligne avec un "X" on initialise la liste des lignes retenues à l'ensemble des lignes du tableau
'copier ici pour la vcd
ReDim line_list_new(n_lignes)
ReDim line_list_old(n_lignes)
For i = 1 To n_lignes
line_list_new(i) = i
line_list_old(i) = i
Next i


' le numéro des projets sélectionnés se trouve dans la deuxième colonne de Tableau

For m = 1 To UBound(correspondance_grp)
' verification que le groupement existe dans la feuille considérée
If correspondance_grp(m) = "0" Then
If tableau(lg, (m + 1)) <> "" Then
MsgBox "le groupement sélectionné n'est pas autorisé"
MsgBox tab_crit_grp(1, m)
GoTo fin
' fin du programme avec message d'erreur
End If

Else

c1 = m + 1

If tableau(lg, c1) <> "" Then
test_tmp = tableau(lg, c1)
tab_projet = Split(test_tmp, ",")
Else
ReDim tab_projet(0)
tab_projet(0) = tableau(lg, c1)
End If



' on discrimine les lignes de PM_meca que l'on conserve
' la matrice avec les nouvelles lignes est line_list_new

c2 = correspondance_pm(m) + 4
n_lignes = UBound(line_list_old)
If tab_projet(0) <> "" Then
ncount0 = 0
For i = 1 To n_lignes
ndim = UBound(tab_projet)
For j = 0 To ndim
stmp = Trim(Tableau_PM_H79(i, c2))
If stmp = tab_projet(j) Then
ncount0 = ncount0 + 1
End If
Next j
Next i

ReDim line_list_new(ncount0)
n_lignes = UBound(line_list_old)
ncount0 = 0
For i = 1 To n_lignes
ndim = UBound(tab_projet)
For j = 0 To ndim
stmp = Trim(Tableau_PM_H79(i, c2))
If stmp = tab_projet(j) Then
ncount0 = ncount0 + 1
line_list_new(ncount0) = line_list_old(i)
End If
Next j
Next i

End If
If ncount0 = 0 Then
MsgBox "l'élement du critère n'existe pas"
MsgBox tab_projet(0)
GoTo fin
End If
n_new = UBound(line_list_new)
ReDim line_list_old(n_new)
For i = 1 To n_new
line_list_old(i) = line_list_new(i)
Next i
End If
dim_list_line(m) = UBound(line_list_old)
Next m
'ici, commence la recuperation et le calcul de tous les volumes de chaque semaine pour les lignes qui correspondent au groupement sélectionné
n = UBound(line_list_old)

num_ligne = 0 ' pas nécessaire, tu vas lui affecter directement la valeur
For i = 1 To n
num_ligne = line_list_old(i) ' ca c 'est ok
s = Tableau_PM_H79(num_ligne, 2) ' as-tu défini s comme un string
tab_semaine = Split(s, "/") 'attention tu dois découper la chaine de caractère du tableay PM_H79
n_semaine = Int(tab_semaine(1)) ' ici tu récupère la valeur
'tab_som_sem = 0 non, surtout pas tu réinitialiserais la valeur à chaque fois en plus tab_som_sem n'existe pas, c'est un tableau
tab_som_sem(n_semaine) = tab_som_sem(n_semaine) + Tableau_PM_H79(num_ligne, 1) ' oui!
Next i

MsgBox tab_som_sem(1)
MsgBox tab_som_sem(2)
MsgBox tab_som_sem(37)

'il fait le regroupement par Quad


' initialisation à zéros des volumes des 4 quatremèstres
For i = 1 To 3
vol_quad(i) = 0
Next i

For i = 1 To 17
vol_quad(1) = vol_quad(1) + tab_som_sem(i)
Next i
For i = 18 To 35
vol_quad(2) = vol_quad(2) + tab_som_sem(i)
Next i
For i = 36 To 52
vol_quad(3) = vol_quad(3) + tab_som_sem(i)
Next i

'eliminer les semaines vides et semaines pas completes
' il compte le nombre des elements vides
ndim2 = 0
For i = 1 To 17
If tab_som_sem(i) <> 0 Then ' attention ici, tab_som_sem est un tableau d'entiers
ndim2 = ndim2 + 1
End If
Next i

' il definit la nouvelle dim
ReDim Tableau_sans_zero_Q1(ndim2)

' il met toutes les valeurs non nulles de l 'ancien tableau dans le nouveau tableau
ndim_count = 0
For i = 1 To 17
If tab_som_sem(i) <> 0 Then
ndim_count = ndim_count + 1
Tableau_sans_zero_Q1(ndim_count) = tab_som_sem(i)
End If
Next i
' si toutes les semaines sont vides, Tableau_sans_zero_Q1 est vide aussi
If UBound(Tableau_sans_zero_Q1) = 0 Then
MsgBox "Tableau_sans_zero_Q1 est vide"
maxLS_Q1 = 0
OcQuad_Q1 = 0
GoTo quad2
End If





'il fait la moyenne de la production



moy = 0
For i = 1 To ndim2
moy = moy + Tableau_sans_zero_Q1(i)

Next i
moy = moy / ndim2
' MsgBox moy
' compter les semaines en moyenne 5 jrs travaillés
ndim3 = 0
For i = 1 To ndim2
tmp = Tableau_sans_zero_Q1(i) - (moy / 2)
If (tmp > 0) Then
ndim3 = ndim3 + 1
End If
Next i

ReDim Tableau_cinq_jours_Q1(ndim3)
'remplir le tableau avec les elts sup moy/2
ndim_count = 0
For i = 1 To ndim2
tmp = Tableau_sans_zero_Q1(i) - (moy / 2)
If tmp > 0 Then
ndim_count = ndim_count + 1
Tableau_cinq_jours_Q1(ndim_count) = Tableau_sans_zero_Q1(i)
End If
Next i

MsgBox ndim3

ReDim Tableau_moy_lis_Q1(ndim3 - 2)
' calcul de toutes les moyennes lissées
For i = 3 To ndim3
Tableau_moy_lis_Q1(i - 2) = (1 / 3) * (Tableau_cinq_jours_Q1(i) + Tableau_cinq_jours_Q1(i - 1) + Tableau_cinq_jours_Q1(i - 2))
Next i

'MsgBox Tableau_moy_lis_Q1(1)
'MsgBox Tableau_moy_lis_Q1(ndim3 - 2)
' calcul de la somme du tableau 5 jours travaillés
OcQuad_Q1 = 0
For i = 1 To ndim3
OcQuad_Q1 = OcQuad_Q1 + Tableau_cinq_jours_Q1(i)
Next i

' MsgBox OcQuad_Q1
' calcul du max 3SL

maxLS_Q1 = 0
For i = 1 To (ndim3 - 2)
If Tableau_moy_lis_Q1(i) > maxLS_Q1 Then
maxLS_Q1 = Tableau_moy_lis_Q1(i)
End If
Next i
'MsgBox maxLS_Q1
' y a plus qu'à continuer
' cas du Quad2
'eliminer les semaines vides et semaines pas completes
' il compte le nombre des elements vides
quad2:

ndim2 = 0
For i = 18 To 35
If tab_som_sem(i) <> 0 Then ' attention ici, tab_som_sem est un tableau d'entiers
ndim2 = ndim2 + 1
End If
Next i

' il definit la nouvelle dim
ReDim Tableau_sans_zero_Q2(ndim2)

' il met toutes les valeurs non nulles de l 'ancien tableau dans le nouveau tableau
ndim_count = 0
For i = 18 To 35
If tab_som_sem(i) <> 0 Then
ndim_count = ndim_count + 1
Tableau_sans_zero_Q2(ndim_count) = tab_som_sem(i)
End If
Next i
' si toutes les semaines sont vides, Tableau_sans_zero_Q2 est vide aussi
If UBound(Tableau_sans_zero_Q2) = 0 Then
MsgBox "Tableau_sans_zero_Q2 est vide"
maxLS_Q2 = 0
OcQuad_Q2 = 0
GoTo quad3
End If
'il fait la moyenne de la production
moy = 0
For i = 1 To ndim2
moy = moy + Tableau_sans_zero_Q2(i)
Next i
If ndim2 = 0 Then
moy = 0
Else
moy = moy / ndim2
End If
' MsgBox moy
' compter les semaines en moyenne 5 jrs travaillés
ndim3 = 0
For i = 1 To ndim2
tmp = Tableau_sans_zero_Q2(i) - (moy / 2)
If (tmp > 0) Then
ndim3 = ndim3 + 1
End If
Next i

ReDim Tableau_cinq_jours_Q2(ndim3)
'remplir le tableau avec les elts sup moy/2
ndim_count = 0
For i = 1 To ndim2
tmp = Tableau_sans_zero_Q2(i) - (moy / 2)
If tmp > 0 Then
ndim_count = ndim_count + 1
Tableau_cinq_jours_Q2(ndim_count) = Tableau_sans_zero_Q2(i)


End If
Next i
ReDim Tableau_moy_lis_Q2(ndim3 - 2)

' calcul de toutes les moyennes lissées
For i = 3 To ndim3
Tableau_moy_lis_Q2(i - 2) = (1 / 3) * (Tableau_cinq_jours_Q2(i) + Tableau_cinq_jours_Q2(i - 1) + Tableau_cinq_jours_Q2(i - 2))
Next i

'MsgBox Tableau_moy_lis_Q2(1)
'MsgBox Tableau_moy_lis_Q2(ndim3 - 2)
' calcul de la somme du tableau 5 jours travaillés
OcQuad_Q2 = 0
For i = 1 To ndim3
OcQuad_Q2 = OcQuad_Q2 + Tableau_cinq_jours_Q2(i)
Next i

' MsgBox OcQuad_Q1
' calcul du max 3SL

maxLS_Q2 = 0
For i = 1 To (ndim3 - 2)
If Tableau_moy_lis_Q2(i) > maxLS_Q2 Then
maxLS_Q2 = Tableau_moy_lis_Q2(i)
End If
Next i
MsgBox maxLS_Q2
' y a plus qu'à continuer

' cas du Quad3
quad3:

'eliminer les semaines vides et semaines pas completes
' il compte le nombre des elements vides
ndim2 = 0
For i = 36 To 52
If tab_som_sem(i) <> 0 Then ' attention ici, tab_som_sem est un tableau d'entiers
ndim2 = ndim2 + 1
End If
Next i

' il definit la nouvelle dim
ReDim Tableau_sans_zero_Q3(ndim2)

' il met toutes les valeurs non nulles de l 'ancien tableau dans le nouveau tableau
ndim_count = 0
For i = 18 To 35
If tab_som_sem(i) <> 0 Then
ndim_count = ndim_count + 1
Tableau_sans_zero_Q3(ndim_count) = tab_som_sem(i)
End If
Next i
' si toutes les semaines sont vides, Tableau_sans_zero_Q3 est vide aussi
If UBound(Tableau_sans_zero_Q3) = 0 Then
MsgBox "Tableau_sans_zero_Q3 est vide"
maxLS_Q3 = 0
OcQuad_Q3 = 0
GoTo fin_quad
End If
'il fait la moyenne de la production
moy = 0
For i = 1 To ndim2
moy = moy + Tableau_sans_zero_Q3(i)

Next i
moy = moy / ndim2
' MsgBox moy
' compter les semaines en moyenne 5 jrs travaillés
ndim3 = 0
For i = 1 To ndim2
tmp = Tableau_sans_zero_Q3(i) - (moy / 2)
If (tmp > 0) Then
ndim3 = ndim3 + 1
End If
Next i

ReDim Tableau_cinq_jours_Q3(ndim3)
'remplir le tableau avec les elts sup moy/2
ndim_count = 0
For i = 1 To ndim2
tmp = Tableau_sans_zero_Q3(i) - (moy / 2)
If tmp > 0 Then
ndim_count = ndim_count + 1
Tableau_cinq_jours_Q3(ndim_count) = Tableau_sans_zero_Q3(i)


End If
Next i
ReDim Tableau_moy_lis_Q3(ndim3 - 2)

' calcul de toutes les moyennes lissées
For i = 3 To ndim3
Tableau_moy_lis_Q3(i - 2) = (1 / 3) * (Tableau_cinq_jours_Q3(i) + Tableau_cinq_jours_Q3(i - 1) + Tableau_cinq_jours_Q3(i - 2))
Next i

'MsgBox Tableau_moy_lis_Q2(1)
'MsgBox Tableau_moy_lis_Q2(ndim3 - 2)
' calcul de la somme du tableau 5 jours travaillés
OcQuad_Q3 = 0
For i = 1 To ndim3
OcQuad_Q3 = OcQuad_Q3 + Tableau_cinq_jours_Q3(i)
Next i

' MsgBox OcQuad_Q1
' calcul du max 3SL

maxLS_Q3 = 0
For i = 1 To (ndim3 - 2)
If Tableau_moy_lis_Q3(i) > maxLS_Q3 Then
maxLS_Q3 = Tableau_moy_lis_Q3(i)
End If
Next i
MsgBox maxLS_Q3
fin_quad:
Next l





MsgBox "exécution sans erreur"
fin:

MsgBox "fin du programme - essayer une nouvelle combinaison de groupement"

End Sub
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : depassement de capacité

Bonjour Hobine, bonjour le forum,

Sans détailler tes codes, regarde les variables délcarées comme Integer. Si elles concernent des lignes, remplace-les par Long. un copier/coller de l'aide VBA :
Les variables de type Integer sont stockées sous la forme de nombres de 16 bits (2 octets) dont la valeur est comprise entre -32 768 et 32 767. Le caractère de déclaration de type Integer est le signe %.
Les variables de type Long (entier long) sont stockées sous la forme de nombres signés de 32 bits (4 octets) dont la valeur est comprise entre -2 147 483 648 et 2 147 483 647. Le caractère de déclaration de type Long est le signe &.

[Édition]
Bonjour Michel on s'est croisé
 

hobine

XLDnaute Nouveau
Re : depassement de capacité

merci pour vos orientations,
j'ai remplacé comme indique, du coup ça marche, super,mais je viens d'avoir un nouveau il s'agit : erreur d'excution'9' : l'indice n'appartient par à la selection
dans cette partie de mon programme : ' il met toutes les valeurs non nulles de l 'ancien tableau dans le nouveau tableau
ndim_count = 0
For i = 18 To 35
If tab_som_sem(i) <> 0 Then
ndim_count = ndim_count + 1
Tableau_sans_zero_Q3(ndim_count) = tab_som_sem(i)
End If
Next i
' si toutes les semaines sont vides, Tableau_sans_zero_Q3 est vide aussi
If UBound(Tableau_sans_zero_Q3) = 0 Then
MsgBox "Tableau_sans_zero_Q3 est vide"
maxLS_Q3 = 0
OcQuad_Q3 = 0
GoTo fin_quad
End If
'il fait la moyenne de la production
moy = 0
For i = 1 To ndim2
moy = moy + Tableau_sans_zero_Q3(i)



comme faire?
 

Discussions similaires

Réponses
6
Affichages
202