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: