[VBA] Erreur Run-time error 13 : type mismatch avec un array/range [Résolu]

jeje1712

XLDnaute Nouveau
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 ...

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:

ROGER2327

XLDnaute Barbatruc
Re : [VBA] Erreur Run-time error 13 : type mismatch avec un array/range

Bonjour jeje1712.


Pas de support pour tester la chose, hélas.

À vue de nez, je ne serais pas étonné que l'erreur survînt lorsque lngPosition excède 65536.​



ROGER2327
#6875


Lundi 2 Haha 141 (Dissolution de Edgar Poe, dinomythurge - fête Suprême Quarte)
16 Vendémiaire An CCXXII, 5,2305h - belle-de-nuit
2013-W41-1T12:33:12Z
 
Dernière édition:

ROGER2327

XLDnaute Barbatruc
Re : [VBA] Erreur Run-time error 13 : type mismatch avec un array/range

Re...


exact, lngPosition est à 74518... mais je ne comprends pas, qu'elle est cette limite à 65536 ?

comment faire dans ce cas-là?
Cette limite vient de ce que Micro ignore ce que fait Soft et réciproquement. Autrement dit, pour faire beau l'un porte la taille des feuilles de 65 536 (= 2[SUP]16[/SUP]) à 1 048 576 (= 2[SUP]20[/SUP]) lignes, tandis que l'autre "oublie" de réécrire les fonctions en conséquence et revend une très vieille fonction TRANSPOSE datant au moins d'Excel97[SUP](c)[/SUP] (dlc largement dépassée !).
Laquelle fonction est limitée à 2[SUP]16[/SUP] lignes.

Remède : Attendre une improbable mise à jour.

Ou bien oublier la fonction TRANSPOSE et construire les tableaux pour ne pas avoir à les transposer. Par exemple en inversant le rôle des lignes et des colonnes :​
VB:
     ReDim arrDataCross(lngSizeArray, 3)
... et en réécrivant le code en conséquence.

Ou encore, oublier la fonction TRANSPOSE, et écrire une fonction de transposition terme à terme, genre :​
VB:
Function TrnsPos(u)
Dim i&, j&, v()
    If VarType(u) >= vbArray Then
        ReDim v(LBound(u, 2) To UBound(u, 2), LBound(u, 1) To UBound(u, 1))
        For i = LBound(u, 1) To UBound(u, 1): For j = LBound(u, 2) To UBound(u, 2): v(j, i) = u(i, j): Next j, i
        TrnsPos = v
    Else
        TrnsPos = u
    End If
End Function


Bon courage.


ROGER2327
#6876


Lundi 2 Haha 141 (Dissolution de Edgar Poe, dinomythurge - fête Suprême Quarte)
16 Vendémiaire An CCXXII, 5,9477h - belle-de-nuit
2013-W41-1T14:16:28Z
 

jeje1712

XLDnaute Nouveau
Re : [VBA] Erreur Run-time error 13 : type mismatch avec un array/range

très bien, je comprend mieux.


J'ai donc modifier tout le code pour inverser l'array, et faire que celui-ci grandisse horizontalement et non plus verticalement, tout en conservant la dimension variable en fin de dimensionnement d'array (pour pouvoir le redimensionner).
Mais je me retrouve avec une erreur "Run-time '1004' : Application-defined or object-defined error", apparaissant au même niveau de cross, lorsque je cherche à retranscrire mon array (tout se passe bien jusqu'au 3 ème niveau)

Code:
   .Range("A2").Resize(3, lngPosition).Value = arrDataCross

avec lngPosition = 41448


Je m'y pencherais demain, d'ici là je suis preneur pour quelconques suggestions.



le code modifié (le nom de la macro a changé, mais c'est la même)

Code:
Static Sub CalculProbabilitéCroiséesPhoto()
'


' 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 wsPOccurenceSimu As Worksheet
Set wsPOccurenceSimu = Worksheets("POccurenceSimu")
Dim wsPOccurencePhoto As Worksheet
Set wsPOccurencePhoto = Worksheets("POccurencePhoto")




'on va simuler les probabilités d'ouvertures croisées

dblNbTool = Application.WorksheetFunction.CountA(wsDataPhoto.Range("A:A")) - 1


With wsPOccurencePhoto
    .Range("A1").Value = "Q (L/min)"
    .Range("B1").Value = "P Occurence"
    .Range("C1").Value = "nom des tools croisés"
    
     intNbToolCross = 0
     lngPosition = 0
     lngSizeArray = dblNbTool
     ReDim arrDataCross(3, lngSizeArray)


    For intTool = 1 To dblNbTool - intNbToolCross
        arrDataCross(0, lngPosition) = wsDataPhoto.Range("C1").Offset(intTool, 0).Value
        arrDataCross(1, lngPosition) = wsDataPhoto.Range("J1").Offset(intTool, 0).Value
        arrDataCross(2, lngPosition) = wsDataPhoto.Range("B1").Offset(intTool, 0).Value
        
      
        lngPosition = lngPosition + 1
    Next intTool
    
    
    .Range("A2").Resize(3, lngPosition).Value = arrDataCross
    
    
    '---------------------------------------------------------------
'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) = _
                wsDataPhoto.Range("C1").Offset(i, 0).Value + _
                wsDataPhoto.Range("C1").Offset(jb, 0).Value
                
                arrDataCross(1, lngPosition) = _
                wsDataPhoto.Range("J1").Offset(i, 0).Value * _
                wsDataPhoto.Range("J1").Offset(jb, 0).Value
                
                arrDataCross(2, lngPosition) = _
                CStr(wsDataPhoto.Range("B1").Offset(i, 0).Value) & " " & _
                CStr(wsDataPhoto.Range("B1").Offset(jb, 0).Value)
            
                            
                            
                lngPosition = lngPosition + 1
                intTool = intTool + 1
                
            Next jb
            j = j + 1 '
            
        Next i
    
    .Range("A2").Resize(3, lngPosition).Value = arrDataCross


    '------------------------------------------
'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) = _
                    wsDataPhoto.Range("C1").Offset(i, 0).Value + _
                    wsDataPhoto.Range("C1").Offset(jb, 0).Value + _
                    wsDataPhoto.Range("C1").Offset(kb, 0).Value
                    
                    arrDataCross(1, lngPosition) = _
                    wsDataPhoto.Range("J1").Offset(i, 0).Value * _
                    wsDataPhoto.Range("J1").Offset(jb, 0).Value * _
                    wsDataPhoto.Range("J1").Offset(kb, 0).Value
                    
                    arrDataCross(2, lngPosition) = _
                    CStr(wsDataPhoto.Range("B1").Offset(i, 0).Value) & " " & _
                    CStr(wsDataPhoto.Range("B1").Offset(jb, 0).Value) & " " & _
                    CStr(wsDataPhoto.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(3, lngPosition).Value = arrDataCross
    

    '---------------------------
'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) = _
                        wsDataPhoto.Range("C1").Offset(i, 0).Value + _
                        wsDataPhoto.Range("C1").Offset(jb, 0).Value + _
                        wsDataPhoto.Range("C1").Offset(kb, 0).Value + _
                        wsDataPhoto.Range("C1").Offset(lb, 0).Value
                        
                        
                        arrDataCross(1, lngPosition) = _
                        wsDataPhoto.Range("J1").Offset(i, 0).Value * _
                        wsDataPhoto.Range("J1").Offset(jb, 0).Value * _
                        wsDataPhoto.Range("J1").Offset(kb, 0).Value * _
                        wsDataPhoto.Range("J1").Offset(lb, 0).Value
                        
                        arrDataCross(2, lngPosition) = _
                        CStr(wsDataPhoto.Range("B1").Offset(i, 0).Value) & " " & _
                        CStr(wsDataPhoto.Range("B1").Offset(jb, 0).Value) & " " & _
                        CStr(wsDataPhoto.Range("B1").Offset(kb, 0).Value) & " " & _
                        CStr(wsDataPhoto.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(3, lngPosition).Value = arrDataCross
        
    End With
    
End Sub
 

ROGER2327

XLDnaute Barbatruc
Re : [VBA] Erreur Run-time error 13 : type mismatch avec un array/range

Re...


(...)
Mais je me retrouve avec une erreur "Run-time '1004' : Application-defined or object-defined error", apparaissant au même niveau de cross, lorsque je cherche à retranscrire mon array (tout se passe bien jusqu'au 3 ème niveau)

Code:
   .Range("A2").Resize(3, lngPosition).Value = arrDataCross

avec lngPosition = 41448
(...)
Normal ! Le nombre de colonnes est limité à 16 384.

Ceci dit, si vous voulez utiliser ReDim Preserve, je ne vois guère que l'utilisation d'une fonction de transposition ad hoc, comme je le suggérais plus haut...

Quelque chose comme
VB:
Dim toto()
    toto = TrnsPos(arrDataCross)
    .Range("A2").Resize(lngPosition, 3).Value = arrDataCross
au lieu de
VB:
    .Range("A2").Resize(lngPosition, 3).Value = Application.WorksheetFunction.Transpose(arrDataCross)
En l'absence de support pour le faire, je n'ai évidemment pas testé.

À vous de voir...


ROGER2327
#6877


Lundi 2 Haha 141 (Dissolution de Edgar Poe, dinomythurge - fête Suprême Quarte)
16 Vendémiaire An CCXXII, 6,7881h - belle-de-nuit
2013-W41-1T16:17:29Z
 

jeje1712

XLDnaute Nouveau
Re : [VBA] Erreur Run-time error 13 : type mismatch avec un array/range

Bonjour ROGER2327,


Bon, si je prends du recul, je sais très bien que transposer mon range sur la feuille excel n'est pas pérenne, car j'aurais forcément plus de 1048576 lignes.

Il faut garder en tête que ceci me permettait de tester si ma construction de macro était correct, j'ai voulu débloquer ceci pour continuer à apprendre en VBA, cad tester de nouvelles fonctions et constructions.

Néanmoins, je pense qu'il n'est pas nécessaire de prendre plus de votre temps et de mon temps sur ce problème.


Passons à un autre problème maintenant ....


J'obtiens donc un array de plusieurs milliers de lignes (voir millions), et je cherche à effectuer un SUMIFS sur cette array :


j'ai 3 colonnes, dont 2 d'intérêts pour cette étape : le débit pour un évènement (position 0 de l'array) et sa probabilité (position 1 de l'array).
je veux donc maintenant sommer toutes les probabilités pour une gamme de débit donné :
- soit pour des débits supérieurs ou égal à x (x allant de 0 à 40) -SUMIF-
- soit pour des débits entre x et x +1 (x allant de 0 à 40) -SUMIFS-

sauf que ces fonctions SUMIFS et SUMIF, j'arrive très bien à les écrire en excel, à les écrire en vba en ciblant des éléments sur la feuille excel, mais je n'arrive pas à le faire en cherchant dans un array ...

exemple :
en exploitant les données sur la feuille excel :
Code:
For i = 1 To intMaxInterval
        .Range("N1").Offset(i, 0).FormulaLocal = "=SUMIFS(B:B;A:A;"">=""&L" & i + 1 & ";A:A;""<""&M" & i + 1 & ")"
    Next i

mais alors en ciblant mon arrDataCross ... :

Code:
For i = 1 To intMaxInterval
        .Range("N1").Offset(i, 0).FormulaLocal = application.WorksheetFunction.SumIfs(.range(arrDatacross($£%%**¨ù???)
  Next i

comment m'en sortir ?


PS:
En l'absence de support pour le faire, je n'ai évidemment pas testé.

À vous de voir...

Oui je sais, je ne préfère pas mettre de feuille excel pour une bonne raison : on apprend mieux par soit même, je préfère que l'on m'aiguille comme vous le faite et que je creuse de mon coté




Cordialement,
Jérôme



EDIT :


En m'inspirant de vos précédent messages :


toutes mes sub sont déclarés en static, et en tête de module :
Code:
Public lngSizeArray As Long
Public arrDataCross() As Variant
Public lngPosition As Long
Public lngPositionMax As Long

Ceci afin de conserver le contenu de mon array entre la macro de calcul de proba et la macro de traitement ci-dessous :


Code:
With wsPOccurenceSimu

'construction avec Q E [x ; x+1]

    .Range("L1").Value = "interval de débit, MIN"
    .Range("M1").Value = "interval de débit, MAX"
    .Range("N1").Value = "Probabilité pour un interval de débit"
    
    'borne
    For i = 1 To intMaxInterval
        .Range("L1").Offset(i, 0).Value = i - 1
        .Range("M1").Offset(i, 0).Value = i
        
    Next i
    
    'calcul
    For i = 1 To intMaxInterval
        intTotP = 0
        For j = LBound(arrDataCross, 1) To UBound(arrDataCross, 1)       
           If arrDataCross(0, j) >= (i - 1) And arrDataCross(0, j) < i Then
                intTotP = intTotP + arrDataCross(1, j)
            End If
        Next j
        .Range("N1").Offset(i, 0).Value = intTotP
    Next i
        
    
'construction avec gamme Q>= x

    .Range("P1").Value = "Q"
    .Range("Q1").Value = "probabilité d'évènements >= Q"
    
    'borne
    For i = 1 To intMaxInterval
        .Range("P1").Offset(i, 0).Value = i - 1
    Next i
    
    'calcul
    For i = 1 To intMaxInterval
        intTotP = 0
        For j = LBound(arrDataCross, 1) To UBound(arrDataCross, 1)
            If arrDataCross(0, j) >= i Then
                intTotP = intTotP + arrDataCross(1, j)
            End If
        Next j
        .Range("N1").Offset(i, 0).Value = intTotP
    Next i
    
   


End With


ce n'est pas encore au point, je test tout ça
 
Dernière édition:

jeje1712

XLDnaute Nouveau
Re : [VBA] Erreur Run-time error 13 : type mismatch avec un array/range

bon je resèche....

déclaration des variables :


Code:
Static Sub TraitementSimu()


' Déclaration des variables

Dim i As Integer
Dim j As Integer
Dim intMaxInterval As Integer
Dim intMincolonne As Integer
Dim intMaxcolonne As Integer
Dim intTotP
Dim intTotQ
Dim intDimMax As Integer

'-----------------------------------
' Déclaration des tableaux
'-----------------------------------
' Déclaration des feuilles

Dim wsPOccurenceSimu As Worksheet
Set wsPOccurenceSimu = Worksheets("POccurenceSimu")



pour info, le nombre de dimension de mon array est stocké dans lngPositionMax


le calcul :

Code:
    .Range("L1").Value = "interval de débit, MIN"
    .Range("M1").Value = "interval de débit, MAX"
    .Range("N1").Value = "Probabilité pour un interval de débit"
    
    'borne
    For i = 1 To intMaxInterval
        .Range("L1").Offset(i, 0).Value = i - 1
        .Range("M1").Offset(i, 0).Value = i
        
    Next i
    
    'calcul
    For i = 1 To intMaxInterval
        intTotP = 0
        For j = 0 To lngPositionMax                           'error overflow ,lngPositionMax =74518
            If arrDataCross(0, j) >= (i - 1) And arrDataCross(0, j) < i Then
                intTotP = intTotP + arrDataCross(1, j)
            End If
        Next j
        .Range("N1").Offset(i, 0).Value = intTotP
    Next i


error overflow sur ma boucle j ...
 
Dernière édition:

jeje1712

XLDnaute Nouveau
Re : [VBA] Erreur Run-time error 13 : type mismatch avec un array/range

Bonjour,


J'ai réussi à régler la plupart de mes problèmes.
Je pense avoir encore besoin d'aide sur ce développement là, mais ça ne fait plus partie du sujet initial. J'ouvrirais un prochain thread au besoin, en tout cas celui-là est clos.

Merci à vous ROGER2327 pour votre aide.
Cordialement,
Jérôme
 

Discussions similaires