Macro Boucle Incorrecte Variable

Version imprimable

Bonjour 8-),

J'essaie depuis plusieurs jours à finaliser une macro pour effectuer la fonction MAX.SI.ENS et MIN.SI.ENS sur une version Excel antérieur où cette formule était valable. Je passe donc par le VBA. Pour ce faire, j'ai été aidé par un pote pour la rédiger. Cependant, la macro ne fonctionne plus aujourd'hui, alors qu'elle tournait à merveille avant.
Je me creuse les méninges comme jamais pour résoudre le problème mais rien n'y fait, je n'arrive pas à régler le problème. J'ai vraiment besoin d'aide :calim2:

La ligne qui me fait défaut est concernant la boucle, le message d'erreur est le suivant "Erreur d'exécution '1004': Erreur définie par l'application ou par l'objet".

Ma variable ne s'arrête pas à la ligne avec la dernière donnée mais continue jusqu'à la dernière ligne de la feuille en question (1 048 576ème). Ce que je souhaite, c'est que la boucle prenne fin à ma dernière ligne avec des données et que la macro poursuive son calcul.

Le fichier est trop lourd pour que je le mette en PJ.
Pouvez-vous m'aider svp?

Voici la bête: :roll:

La ligne qui bloque est celle-ci Loop While Cells(j, MadTh) = Cells(j + 1, MadTh) And IsEmpty(Cells(j, MadTh))

Code:

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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
Sub Max_Pkg()  '---------------  Macro Fin de Picking -------------------
 
Dim i As Variant
Dim j As Variant
Dim CelDprt1, CelDprt2 As Long
Dim CelFin1, CelFin2 As Long
Dim DernCol As String
Dim ColNum As Long
Dim DernLign As Long
Dim DateImport, MadTh, FinPkg As Long
 
ColNum = Cells(1, Columns.Count).End(xlToLeft).Column 'determine la derniere valeur ligne 1
DernCol = GetColumnLetter(ColNum) 'determine la lettre correspondant a la dernière colonne ligne 1
DernLign = Range("A1048576").End(xlUp).Row 'determine la derniere valeur colonne A
 
 
'-------------- Determine les numéros de colonnes DateImport / MaD Théorique / Fin de Picking ----------
 
For Each x In Range("A1:" & DernCol & ColNum)
   If x = "Date import" Then
       Range(x, x.End(xlToLeft)).Select
       DateImport = Selection.Cells.SpecialCells(xlCellTypeConstants).Count
   End If
   If x = "Mise à dispo théorique" Then
       Range(x, x.End(xlToLeft)).Select
       MadTh = Selection.Cells.SpecialCells(xlCellTypeConstants).Count
   End If
   If x = "Fin Picking" Then
       Range(x, x.End(xlToLeft)).Select
       FinPkg = Selection.Cells.SpecialCells(xlCellTypeConstants).Count
   End If
Next
 
'-------------- Filtre les données par Date Import puis MaD Théorique et enfin par heure de Fin de Picking ------------------
 
Range("A1").CurrentRegion.Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range(Cells(2, DateImport), Cells(DernLign, DateImport)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveSheet.Sort.SortFields.Add Key:=Range(Cells(2, MadTh), Cells(DernLign, MadTh)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveSheet.Sort.SortFields.Add Key:=Range(Cells(2, FinPkg), Cells(DernLign, FinPkg)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   With ActiveSheet.Sort
       .SetRange Range("A1:" & DernCol & DernLign)
       .Header = xlYes
       .MatchCase = False
       .Orientation = xlTopToBottom
       .SortMethod = xlPinYin
       .Apply
   End With
 
 
'-------------- Converti les données des heures de la colonne Fin de picking -------------------------
 
Columns(FinPkg).Select
   Selection.TextToColumns , DataType:=xlDelimited, _
       TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
       Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
       :=Array(1, 1), TrailingMinusNumbers:=True
 
 
'-------------- Loop parmi DateImport, puis MaD Théorique pour determiner le max de Fin de Picking -------------------------
 
For i = 2 To DernLign
If Cells(i - 1, DateImport) <> Cells(i, DateImport) Then ' cas ou la référence est différente
   CelDprt1 = i
Do
   i = i + 1
Loop While Cells(i, DateImport) = Cells(i + 1, DateImport) Or IsEmpty(Cells(i, DateImport))
   CelFin1 = i
 
   For j = CelDprt1 To CelFin1
   If Cells(j - 1, MadTh) <> Cells(j, MadTh) Then  ' cas ou la référence est différente
       CelDprt2 = j
   Do
       j = j + 1
   Loop While Cells(j, MadTh) = Cells(j + 1, MadTh) And IsEmpty(Cells(j, MadTh))
       CelFin2 = j
 
       For k = CelDprt2 To CelFin2
           Cells(k, 51).FormulaR1C1 = "=MAX(R" & CelDprt2 & "C" & FinPkg & ":R" & CelFin2 & "C" & FinPkg & ")"
           'Variable Cells(k, 51) a changer pour l'emplacement du resultat de la formule max
           'exemple 51 = colonne AY, change en 1 pour colonne A etc ...
       Next
 
   End If
   Next
 
End If
Next
 
Columns("AY:AY").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
End Sub

04/07/2019, 13h42
philest

Citation:

La ligne qui bloque est celle-ci "Loop While Cells(j, MadTh) = Cells(j + 1, MadTh) And IsEmpty(Cells(j, MadTh))"

Bonjour
Peut-être que le problème vient de la déclaration de tes variables au début de procédure
Dim DateImport, MadTh, FinPkg As Long

MadTh est il de type variant ou Long ?
04/07/2019, 14h06
Trystan441

Bonjour,

Vu que tu boucles jusqu'à la dernière ligne de ta feuille, vérifie la valeur de tes variables pour ensuite savoir si la condition nécessaire à la sortie de la boucle est possible

Code:

Dim DateImport, MadTh, FinPkg As Long

Ici, tes variables DateImport et MadTh sont de types Variant.
Pour leur attribuer un type, procède de la manière suivante :

Code:

Dim DateImport as long, MadTh as long, FinPkg as long

Bonjour,

If faut mettre le As + type de la variable à chaque fois.
Une virgule sur la même ligne ne suffit pas. travailler en ligne, te permet seulement de ne mettre Dim qu'une fois... pas le reste.
Quand on ne met rien, la valeur par défaut est As Variant.
Code:

1 2 3 4 Dim i As Variant, j As Variant Dim DernCol As String Dim CelDprt1 As Long, CelDprt2 As Long, CelFin1 As Long, CelFin2 As Long Dim ColNum As Long, DernLign As Long, DateImport As Long, MadTh As Long, FinPkg As Long
Bonne journée.

Bonjour,

Autre approximation.
Code:

1 2 3 4 Columns("AY:AY").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False
1 - Il aurait été opportun de définir la ligne de la dernière cellule
2 - faire un collage spécial de valeurs en 1 ligne, en supprimant les sélections
Code:

1 2 3 4 5 6 7 8 Dim derlign as Long With Worksheets("lawks") derlign = .Cells(.Rows.Count,56).End(xlUp).Rpw With .Range("AY2:AY" & derlign) .Value = .Value End With End With

04/07/2019, 16h32
MathBVBA

Réponse

Bonjour à tous,

Tout d'abord, merci pour vos réponses. Je vais essayer de répondre à vos messages dans l'ordre.

@philest En effet, les données en colonne MadTh sont en heure, il serait donc plus judicieux de mettre un type Date, néanmoins, après vérification, c'est j qui ne doit pas être bon puisque j doit être un nombre entier donc pas un "Variant" mais en "Long".

Je pense que vous avez mis le point là où ça ne passait pas, puisque la macro tourne finalement, sauf qu'elle ne met pas quelques secondes comme avant mais une bonne demi-heure. Tu as raison @Trystan441 au lieu de fonctionner sur quelque chose comme 10 000 lignes habituellement, la valeur de j est 1 048 596, donc elle tourne sur l'ensemble des cellules de la colonne MadTh et met environ 83 fois plus de temps que d'habitude.

Merci @electroweb, je vais changer l'écriture des variables, pour qu'elles ne soient pas en variant.

Enfin @MarcelG, je le reconnais cette partie n'a pas été rédiger, j'avais simplement fait un enregistrement d'où le fait que la colonne AY soit entièrement sélectionnée.

Après toutes les modifications, je vous tiendrai informé. Merci énormément du coup de pouce en tout cas!!!