bonjour,
j'ai une liste de noms de machine, et sur la meme ligne pour chaque nom le débit et la probabilité d'occurence.
Je cherche à calculer tout les évènements possible de présence simultanée, d'abords simple, puis en duo, puis en triplette, puis et quatuor etc.... jusqu'au nombre total de machine que j'ai. A chaque évènements est associé la somme des débits de l'occurence ainsi que le produit des probabilité d'occurence individuel.
pour l'instant, j'arrive à construire la routine sur 8 niveau (évènements correspondant à 7 machine en même temps), mais je n'ai pas encore trouvé la logique pour le boucler sur le nombre total de machine que j'ai . . . j'y travail, là n'est pas la question.
j'avais initialement construit ceci en écrivant les infos sur une feuille excel, mais très vite j'ai saturé la feuille (>1 500 000 la limite max d'affichage sur une feuille), du coup je suis passé par un array.
afin de controler que l'exécution est correcte, j'ai demandé à ce que l'array soit transposée sur la feuille à chaque fin de cross (c'est à dire dès que l'on a fini de construire les duo, ou triplette, ou quadrplette etc....), et bizarrement ça plante avec une erreur 13 type mismatch au bout de la 2ème occurence (formation des triplettes)
ci-dessous le code, tronqué au niveau 3. pour information, je n'ai aucun pb avec l'exécution propre de la macro, tout mes compteurs sont à la bonne valeurs, donc tout se passe bien, mais ça plante avec un type mismatch sur l'array et je ne trouve pas pourquoi ...
j'ai une liste de noms de machine, et sur la meme ligne pour chaque nom le débit et la probabilité d'occurence.
Je cherche à calculer tout les évènements possible de présence simultanée, d'abords simple, puis en duo, puis en triplette, puis et quatuor etc.... jusqu'au nombre total de machine que j'ai. A chaque évènements est associé la somme des débits de l'occurence ainsi que le produit des probabilité d'occurence individuel.
pour l'instant, j'arrive à construire la routine sur 8 niveau (évènements correspondant à 7 machine en même temps), mais je n'ai pas encore trouvé la logique pour le boucler sur le nombre total de machine que j'ai . . . j'y travail, là n'est pas la question.
j'avais initialement construit ceci en écrivant les infos sur une feuille excel, mais très vite j'ai saturé la feuille (>1 500 000 la limite max d'affichage sur une feuille), du coup je suis passé par un array.
afin de controler que l'exécution est correcte, j'ai demandé à ce que l'array soit transposée sur la feuille à chaque fin de cross (c'est à dire dès que l'on a fini de construire les duo, ou triplette, ou quadrplette etc....), et bizarrement ça plante avec une erreur 13 type mismatch au bout de la 2ème occurence (formation des triplettes)
ci-dessous le code, tronqué au niveau 3. pour information, je n'ai aucun pb avec l'exécution propre de la macro, tout mes compteurs sont à la bonne valeurs, donc tout se passe bien, mais ça plante avec un type mismatch sur l'array et je ne trouve pas pourquoi ...
Code:
Dim lngSizeArray As Long
Dim arrDataCross() As Variant
Dim lngPosition As Long
Static Sub CalculProbabilitéCroisées()
'
' Déclaration des variables
Dim dblNbTool As Double
Dim intTool As Integer
Dim dblSumOccu As Double
Dim dblTemps As Double
Dim intNbToolCross As Integer
Dim dblFactorielleNP As Double
Dim dblFactorielleP As Double
Dim dblFactorielle As Double
Dim dblFactorielleN As Double
Dim i As Integer
Dim ib As Integer
Dim j As Integer
Dim jb As Integer
Dim k As Integer
Dim kb As Integer
Dim l As Integer
Dim lb As Integer
Dim m As Integer
Dim mb As Integer
Dim n As Integer
Dim nb As Integer
Dim o As Integer
Dim ob As Integer
Dim p As Integer
Dim pb As Integer
'-----------------------------------
' Déclaration des tableaux
'-----------------------------------
' Déclaration des feuilles
Dim wsDataPhoto As Worksheet
Set wsDataPhoto = Worksheets("DataPhoto")
Dim wsDataSimu As Worksheet
Set wsDataSimu = Worksheets("DataSimu")
Dim wsPOccurence As Worksheet
Set wsPOccurence = Worksheets("POccurence")
dblNbTool = Application.WorksheetFunction.CountA(wsDataSimu.Range("A:A")) - 1
With wsPOccurence
.Range("A1").Value = "Q (L/min)"
.Range("B1").Value = "P Occurence"
.Range("C1").Value = "nom des tools croisés"
intNbToolCross = 0
lngPosition = 0 '=> me sert à compter la position à laquelle on se situe dans l'array
lngSizeArray = dblNbTool
ReDim arrDataCross(3, lngSizeArray)
For intTool = 1 To dblNbTool - intNbToolCross
arrDataCross(0, lngPosition) = wsDataSimu.Range("C1").Offset(intTool, 0).Value
arrDataCross(1, lngPosition) = wsDataSimu.Range("K1").Offset(intTool, 0).Value
arrDataCross(2, lngPosition) = wsDataSimu.Range("B1").Offset(intTool, 0).Value
lngPosition = lngPosition + 1
Next intTool
.Range("A2").Resize(lngPosition, 3).Value = Application.WorksheetFunction.Transpose(arrDataCross)
la dernière ligne s'exécute très bien, pas d'erreur là dessus
'---------------------------------------------------------------
'1er niveau de bouclage, on forme des doubles
intNbToolCross = 1
'avant tout, il faut calculer le nombre d'évènements possible pour dimensionner notre array
' rappel : C = n! / ( p! * (n-p)! ) car les identiques sont interdits
' avec n le nombre d'éléments dans la liste et p le type de groupe que l'on veut faire
i = 1
dblFactorielleNP = 1
While (i <= (dblNbTool - intNbToolCross - 1))
dblFactorielleNP = dblFactorielleNP * i
i = i + 1
Wend
i = 1
dblFactorielleP = 1
While (i <= (intNbToolCross + 1))
dblFactorielleP = dblFactorielleP * i
i = i + 1
Wend
i = 1
dblFactorielleN = 1
While (i <= (dblNbTool))
dblFactorielleN = dblFactorielleN * i
i = i + 1
Wend
dblFactorielle = dblFactorielleN / (dblFactorielleP * dblFactorielleNP)
lngSizeArray = lngSizeArray + dblFactorielle
ReDim Preserve arrDataCross(3, lngSizeArray)
' puis on boucle pour construire tout les croisements
intTool = 1
j = 2
For i = 1 To dblNbTool - intNbToolCross
For jb = j To dblNbTool
arrDataCross(0, lngPosition) = _
wsDataSimu.Range("C1").Offset(i, 0).Value + _
wsDataSimu.Range("C1").Offset(jb, 0).Value
arrDataCross(1, lngPosition) = _
wsDataSimu.Range("K1").Offset(i, 0).Value * _
wsDataSimu.Range("K1").Offset(jb, 0).Value
arrDataCross(2, lngPosition) = _
CStr(wsDataSimu.Range("B1").Offset(i, 0).Value) & " " & _
CStr(wsDataSimu.Range("B1").Offset(jb, 0).Value)
lngPosition = lngPosition + 1
intTool = intTool + 1
Next jb
j = j + 1 '
Next i
.Range("A2").Resize(lngPosition, 3).Value = Application.WorksheetFunction.Transpose(arrDataCross)
la dernière ligne s'exécute très bien, pas d'erreur là dessus
'------------------------------------------
'2eme niveau de bouclage, on fait des triplettes
intNbToolCross = 2
'avant tout, il faut calculer le nombre d'évènements possible pour dimensionner notre array
' rappel : C = n! / ( p! * (n-p)! ) car les identiques sont interdits
' avec n le nombre d'éléments dans la liste et p le type de groupe que l'on veut faire
i = 1
dblFactorielleNP = 1
While (i <= (dblNbTool - intNbToolCross - 1))
dblFactorielleNP = dblFactorielleNP * i
i = i + 1
Wend
i = 1
dblFactorielleP = 1
While (i <= (intNbToolCross + 1))
dblFactorielleP = dblFactorielleP * i
i = i + 1
Wend
i = 1
dblFactorielleN = 1
While (i <= (dblNbTool))
dblFactorielleN = dblFactorielleN * i
i = i + 1
Wend
dblFactorielle = dblFactorielleN / (dblFactorielleP * dblFactorielleNP)
lngSizeArray = lngSizeArray + dblFactorielle
ReDim Preserve arrDataCross(3, lngSizeArray)
intTool = 1
j = 2
k = 3
For i = 1 To (dblNbTool - intNbToolCross)
For jb = j To dblNbTool
For kb = k To dblNbTool
arrDataCross(0, lngPosition) = _
wsDataSimu.Range("C1").Offset(i, 0).Value + _
wsDataSimu.Range("C1").Offset(jb, 0).Value + _
wsDataSimu.Range("C1").Offset(kb, 0).Value
arrDataCross(1, lngPosition) = _
wsDataSimu.Range("K1").Offset(i, 0).Value * _
wsDataSimu.Range("K1").Offset(jb, 0).Value * _
wsDataSimu.Range("K1").Offset(kb, 0).Value
arrDataCross(2, lngPosition) = _
CStr(wsDataSimu.Range("B1").Offset(i, 0).Value) & " " & _
CStr(wsDataSimu.Range("B1").Offset(jb, 0).Value) & " " & _
CStr(wsDataSimu.Range("B1").Offset(kb, 0).Value)
lngPosition = lngPosition + 1
intTool = intTool + 1
Next kb
k = k + 1
Next jb
j = j + 1
k = j + 1
Next i
.Range("A2").Resize(lngPosition, 3).Value = Application.WorksheetFunction.Transpose(arrDataCross)
la dernière ligne s'exécute très bien, pas d'erreur là dessus
'---------------------------
'3eme niveau de bouclage, on fait des quadriplets
'avant tout, il faut calculer le nombre d'évènements possible pour dimensionner notre array
' rappel : C = n! / ( p! * (n-p)! ) car les identiques sont interdits
' avec n le nombre d'éléments dans la liste et p le type de groupe que l'on veut faire
i = 1
intNbToolCross = 3
dblFactorielleNP = 1
While (i <= (dblNbTool - intNbToolCross - 1))
dblFactorielleNP = dblFactorielleNP * i
i = i + 1
Wend
i = 1
dblFactorielleP = 1
While (i <= (intNbToolCross + 1))
dblFactorielleP = dblFactorielleP * i
i = i + 1
Wend
i = 1
dblFactorielleN = 1
While (i <= (dblNbTool))
dblFactorielleN = dblFactorielleN * i
i = i + 1
Wend
dblFactorielle = dblFactorielleN / (dblFactorielleP * dblFactorielleNP)
lngSizeArray = lngSizeArray + dblFactorielle
ReDim Preserve arrDataCross(3, lngSizeArray)
j = 2
k = 3
l = 4
For i = 1 To (dblNbTool - intNbToolCross)
For jb = j To dblNbTool
For kb = k To dblNbTool
For lb = l To dblNbTool
arrDataCross(0, lngPosition) = _
wsDataSimu.Range("C1").Offset(i, 0).Value + _
wsDataSimu.Range("C1").Offset(jb, 0).Value + _
wsDataSimu.Range("C1").Offset(kb, 0).Value + _
wsDataSimu.Range("C1").Offset(lb, 0).Value
arrDataCross(1, lngPosition) = _
wsDataSimu.Range("K1").Offset(i, 0).Value * _
wsDataSimu.Range("K1").Offset(jb, 0).Value * _
wsDataSimu.Range("K1").Offset(kb, 0).Value * _
wsDataSimu.Range("K1").Offset(lb, 0).Value
arrDataCross(2, lngPosition) = _
CStr(wsDataSimu.Range("B1").Offset(i, 0).Value) & " " & _
CStr(wsDataSimu.Range("B1").Offset(jb, 0).Value) & " " & _
CStr(wsDataSimu.Range("B1").Offset(kb, 0).Value) & " " & _
CStr(wsDataSimu.Range("B1").Offset(lb, 0).Value)
lngPosition = lngPosition + 1
Next lb
l = l + 1
Next kb
k = k + 1
l = k + 1
Next jb
j = j + 1
k = j + 1
l = k + 1
Next i
.Range("A2").Resize(lngPosition, 3).Value = Application.WorksheetFunction.Transpose(arrDataCross)
NE MARCHE PAS, ERREUR MISMATCH
End With
End Sub
Dernière édition: