Dépassement des capacités

Question

Bonjour, je suis embêtée par mon VBA avec un message d'erreur dépassement des capacités. Pouvez vous m'aider ? voici le code :

Sub DS1()

'0) VERIFIER QUE LES DOSES SONT RENSEIGNEES
If Sheets("Donnees").Range("B26") = "" Then
MsgBox ("Renseigner au moins une dose standardisée avec son intervalle de couverture inférieur/supérieur")
Exit Sub
Else

'0) EFFACER LES DONNEES EXISTANTES
Range("D5:NE11").Select
Selection.ClearContents

'1) DONNEES

'fixer la case spécialité et les solvants
Dim Specialite As String
Specialite = Sheets("Donnees").Range("B11")
Dim Solvant1 As String
Solvant1 = Sheets("Donnees").Range("B12")
Dim Solvant2 As String
Solvant2 = Sheets("Donnees").Range("B13")
Dim Solvant3 As String
Solvant3 = Sheets("Donnees").Range("B14")
Dim Solvant4 As String
Solvant4 = Sheets("Donnees").Range("B15")
Dim Solvant5 As String
Solvant5 = Sheets("Donnees").Range("B16")

'fixer les intervalle de dose
'DS1
DoInf1 = Sheets("Donnees").Range("B27")
DoSup1 = Sheets("Donnees").Range("C27")
'DS2
DoInf2 = Sheets("Donnees").Range("B28")
DoSup2 = Sheets("Donnees").Range("C28")
'DS3
DoInf3 = Sheets("Donnees").Range("B29")
DoSup3 = Sheets("Donnees").Range("C29")
'DS4
DoInf4 = Sheets("Donnees").Range("B30")
DoSup4 = Sheets("Donnees").Range("C30")

DoInf5 = Sheets("Donnees").Range("B31")
DoSup5 = Sheets("Donnees").Range("C31")

'Date début / date fin période d'étude:
'date début:
Dim DDeb As Date
DDeb = Sheets("Donnees").Range("F5").Value
'date fin
Dim DFin As Date
DFin = Sheets("Donnees").Range("F6").Value

'définir le chemin où se trouve l'ordonnancier à ouvrir
Chemin = Sheets("Donnees").Range("B21")
'définir le nom du fichier à ouvrir
Ordo = Sheets("Donnees").Range("B22").Value
'définir l'extension
Extension = Sheets("Donnees").Range("B23").Value
'nom complet
Ordonnancier = Ordo & "." & Extension
'ouvrir le fichier concerné
Workbooks.Open Filename:=Chemin & "\" & Ordonnancier

'définir les plages sur l'ordonnancier:
'dernière ligne
Dim derligne As Integer
derligne = Range("A65535").End(xlUp).Row

'plage date:
Dim PDate As Range
Set PDate = Workbooks(Ordonnancier).Sheets("Feuil1").Range("E2:E" & derligne)
'plage spécialité:
Dim PSpe As Range
Set PSpe = Workbooks(Ordonnancier).Sheets("Feuil1").Range("J2:J" & derligne)
'plage solvant:
Dim PSolv As Range
Set PSolv = Workbooks(Ordonnancier).Sheets("Feuil1").Range("M2:M" & derligne)
'plage dose:
Dim PDose As Range
Set PDose = Workbooks(Ordonnancier).Sheets("Feuil1").Range("K2:K" & derligne)

'2) ANALYSE DES DONNEES
'Pour chaque date
ThisWorkbook.ActiveSheet.Activate
For i = 4 To 370 'le 1/01 est en colonne 4 jusqu'au dernier jour en 370

Dim VarDate As Date
VarDate = Cells(3, i).Value

'Si la date est comprise dans la période à étudier:
If VarDate >= DDeb And VarDate <= DFin Then

'Compter le nombre de préparations fabriquées:
Prep = Application.WorksheetFunction.CountIf(PDate, VarDate)
'Inscire cette valeur
ActiveSheet.Cells(5, i).Value = Prep

'Compter le nombre de diffuseurs de 5FU (tous dosages confondus) fabriqués
NG = Application.WorksheetFunction.Sum(Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PSolv, Solvant1), Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PSolv, Solvant2), Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PSolv, Solvant3), Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PSolv, Solvant4), Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PSolv, Solvant5))
ActiveSheet.Cells(6, i).Value = NG

'Compter le nombre de diffuseurs correspondant à la DS1
SDB1 = Application.WorksheetFunction.Sum(Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PDose, ">=" & DoInf1, PDose, "<=" & DoSup1, PSolv, Solvant1), Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PDose, ">=" & DoInf1, PDose, "<=" & DoSup1, PSolv, Solvant2), Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PDose, ">=" & DoInf1, PDose, "<=" & DoSup1, PSolv, Solvant3), Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PDose, ">=" & DoInf1, PDose, "<=" & DoSup1, PSolv, Solvant4), Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PDose, ">=" & DoInf1, PDose, "<=" & DoSup1, PSolv, Solvant5))
ThisWorkbook.ActiveSheet.Cells(7, i).Value = SDB1
'Compter le nombre de diffuseurs correspondant à la DS2
SDB2 = Application.WorksheetFunction.Sum(Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PDose, ">=" & DoInf2, PDose, "<=" & DoSup2, PSolv, Solvant1), Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PDose, ">=" & DoInf2, PDose, "<=" & DoSup2, PSolv, Solvant2), Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PDose, ">=" & DoInf2, PDose, "<=" & DoSup2, PSolv, Solvant3), Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PDose, ">=" & DoInf2, PDose, "<=" & DoSup2, PSolv, Solvant4), Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PDose, ">=" & DoInf2, PDose, "<=" & DoSup2, PSolv, Solvant5))
ThisWorkbook.ActiveSheet.Cells(8, i).Value = SDB2
'Compter le nombre de diffuseurs correspondant à la DS3
SDB3 = Application.WorksheetFunction.Sum(Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PDose, ">=" & DoInf3, PDose, "<=" & DoSup3, PSolv, Solvant1), Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PDose, ">=" & DoInf3, PDose, "<=" & DoSup3, PSolv, Solvant2), Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PDose, ">=" & DoInf3, PDose, "<=" & DoSup3, PSolv, Solvant3), Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PDose, ">=" & DoInf3, PDose, "<=" & DoSup3, PSolv, Solvant4), Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PDose, ">=" & DoInf3, PDose, "<=" & DoSup3, PSolv, Solvant5))
ThisWorkbook.ActiveSheet.Cells(9, i).Value = SDB3
'Compter le nombre de diffuseurs correspondant à la DS4
SDB4 = Application.WorksheetFunction.Sum(Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PDose, ">=" & DoInf4, PDose, "<=" & DoSup4, PSolv, Solvant1), Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PDose, ">=" & DoInf4, PDose, "<=" & DoSup4, PSolv, Solvant2), Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PDose, ">=" & DoInf4, PDose, "<=" & DoSup4, PSolv, Solvant3), Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PDose, ">=" & DoInf4, PDose, "<=" & DoSup4, PSolv, Solvant4), Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PDose, ">=" & DoInf4, PDose, "<=" & DoSup4, PSolv, Solvant5))
ThisWorkbook.ActiveSheet.Cells(10, i).Value = SDB4
'Compter le nombre de diffuseurs correspondant à la DS5
SDB5 = Application.WorksheetFunction.Sum(Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PDose, ">=" & DoInf5, PDose, "<=" & DoSup5, PSolv, Solvant1), Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PDose, ">=" & DoInf5, PDose, "<=" & DoSup5, PSolv, Solvant2), Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PDose, ">=" & DoInf5, PDose, "<=" & DoSup5, PSolv, Solvant3), Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PDose, ">=" & DoInf5, PDose, "<=" & DoSup5, PSolv, Solvant4), Application.WorksheetFunction.CountIfs(PDate, VarDate, PSpe, Specialite, PDose, ">=" & DoInf5, PDose, "<=" & DoSup5, PSolv, Solvant5))
ThisWorkbook.ActiveSheet.Cells(11, i).Value = SDB5
End If
Next i

'Terminer
Application.ScreenUpdating = True
'Fermer l'ordonnancier
Workbooks(Ordonnancier).Close

End If
End Sub

Curulis · Accepted Answer

Pas très clair comme code. Mais, sans ton 'Ordonnancier', je ne vois pas comment travailler... S'il n'y a pas trop de secrets là-dedans, on peut l'avoir ou un truc bidouillé, en tout cas ? A+...

Curulis · Answer

Deux petites habitudes à prendre pour être efficace: - utiliser l'icône " &lt;/&gt; " dans la barre d'outil pour insérer un code dans ton message. - joindre un fichier A+...