Bonjour ,

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

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:

La ligne qui bloque est celle-ci Loop While Cells(j, MadTh) = Cells(j + 1, MadTh) And IsEmpty(Cells(j, MadTh))
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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