Erreur d'execution 1004 avec resize

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

j'ai un probleme actuellement avec un resize de ma plage pour coller un tableau. C'est trés surprenant et ca ressemble à une limitation.

J'ai déjà du faire face à une limitation avec la transposition, et j'ai créé la fonction transposition.
le probleme est dans le resize. on notera qu'il ya bien le bon nombre de ligne et de colonnes dans la plage, donc je ne comprend pas....
Je transpose des resultats que je souhaite coller dans une plage.Pièce jointe 342949

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
 
'fonction pour transposer un vecteur sans limitation de taille
Function TransposeV(ByRef MyTab)
    Dim i As Long, j As Long, More As Byte
    Dim MyTabTrans()
 
    'redimentionnement
    If LBound(MyTab) = 0 Then More = 1 Else More = 0
    ReDim Preserve MyTabTrans(1 To UBound(MyTab, 2) + More, 1 To UBound(MyTab) + More)
 
    'Echange Lignes ==> Colonnes
    For i = LBound(MyTab) To UBound(MyTab)
        For j = LBound(MyTab, 2) To UBound(MyTab, 2)
            MyTabTrans(j + More, i + More) = MyTab(i, j)
        Next j
    Next i
 
    'Attribution
    TransposeV = MyTabTrans
End Function

Code:

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
 
'Tableau complet des erreurs lors de l'integration dans la Base de données
Sub VectHdlErrOrAlerte(ByRef MyDico As Dictionary, Optional ByRef MyDicoID As Dictionary, Optional ByRef MyDicoDarCol As Dictionary, Optional ByVal MyDar As String, Optional ByVal Alerte As Boolean = False)
    Dim Rct As New ADODB.Recordset, strSQL As String, MyLast(), MyKeyID As String
    Dim MyDarStr As String, MyTabErr(), NbRow As Long, k As Long, MyNewID As String
    Dim i As Long, MyKey, MySelection As String, MyTab(), n As Long
 
    With ThisWorkbook.Worksheets("Errors_Details")
        'Nettoyage
        .Range(.Range("Start_Erreurs"), .Range("Start_Erreurs").End(xlDown).Offset(, 5)).ClearContents
        .Range(.Range("Start_Alertes"), .Range("Start_Alertes").End(xlDown).Offset(, 8)).ClearContents
    End With
 
    'si alerte mais pas de DAR histo ==> on le fait pas
    If Alerte Then
        'Last DAR
        MyDarStr = Format(LastDar(MyDar), "dd/mm/yyyy")
        If Not MyDicoDarCol.Exists(MyDarStr) Then Alerte = False
    End If
 
    'Nb clef
    If MyDico.Count > 0 Then
        NbRow = MyDico.Count
 
        'Redimentionner le tableau
        ReDim Preserve MyTabErr(NbRow, 5)
 
        'on parcours les references de clefs des erreurs
        i = 0
        For Each MyKey In MyDico.Keys
            'Attribution des valeurs ds un Tableau
            MyTabErr(i, 0) = MyDico(MyKey).MyETB: MyTabErr(i, 1) = MyDico(MyKey).MyID
            MyTabErr(i, 2) = MyDico(MyKey).MyPb: MyTabErr(i, 3) = MyDico(MyKey).MyReport
            MyTabErr(i, 4) = MyDico(MyKey).MySheet: MyTabErr(i, 5) = "'" & MyDico(MyKey).MyFunction
            i = i + 1
        Next MyKey
 
        'Attribution
        With ThisWorkbook.Worksheets("Errors_Details")
 
            'copy des erreurs
            .Range("Start_Erreurs").Resize(UBound(MyTabErr) + 1, UBound(MyTabErr, 2) + 1).Value = MyTabErr
        End With
    End If
 
    If Alerte Then
        'Requete pour selectionner les ID avec un Historique (donc <>0)
        strSQL = "SELECT [ETB],[ID],([" & MyDar & "]-[" & MyDarStr & "])/[" & MyDarStr & "],[" & MyDar & "],[" & MyDarStr & "] FROM [Base_Donnee$] WHERE [" & MyDarStr & "] <> 0 AND [ID]<>'Format' AND [TypeD]='ETB' "
        Rct.Open strSQL, myConnection, adOpenDynamic, adLockPessimistic
        'copier les alertes
        If Not Rct.EOF Then
            MyTab = Application.WorksheetFunction.Transpose(Rct.GetRows)
            For i = LBound(MyTab) To UBound(MyTab)
 
                'ID from la base de donnees
                MyKeyID = Mid(MyTab(i, 2), InStr(MyTab(i, 2), "__") + 2)
                If MyDicoID.Exists(MyKeyID) Then
                    If Abs(CDbl(MyTab(i, 3))) > MyDicoID(MyKeyID).MyNorme Then
                        k = k + 1
                        ReDim Preserve MyLast(1 To 9, 1 To k)
                        For n = 1 To 5
                            MyLast(n, k) = MyTab(i, n)
                        Next n
                        MyNewID = Mid(MyTab(i, 2), InStr(MyTab(i, 2), "__") + 2, Len(MyTab(i, 2)) - InStr(MyTab(i, 2), "__") + 2)
                        MyLast(6, k) = MyDicoID(MyNewID).MyNorme
                        MyLast(7, k) = MyDicoID(MyNewID).MyReport
                        MyLast(8, k) = MyDicoID(MyNewID).MySheet
                        MyLast(9, k) = MyDicoID(MyNewID).MyFunction
                    End If
                End If
            Next i
 
 
            'copy des variations alertes si il y'en a
            If Not IsEmpty_V(MyLast) Then
                With ThisWorkbook.Worksheets("Errors_Details")
 
                    .Range("Start_Alertes").Resize(UBound(MyLast,2), UBound(MyLast)) = TransposeV(MyLast)
                End With
            End If
        End If
    End If
 
    'MAJ des indicateurs "Nb erreurs et Nb Alertes"
    ThisWorkbook.Worksheets("Errors_Details").Calculate
    Set Rct = Nothing
End Sub

16/01/2018, 12h42
pijaku
Bonjour,

La seule limite de Resize est celle de ta feuille.

Ce code, sous 2010, plante à la seconde ligne, mais pas sur la première.
Code:

1 2 3 4 Sub essai() Debug.Print Range("A1").Resize(1048576, 16384).Address Debug.Print Range("B1").Resize(1048576, 16384).Address End Sub
16/01/2018, 12h59
Phil Free

Bonjour,

je ne comprend pas car tu utilise Ubound ici :

Code:

.Range("Start_Alertes").Resize(UBound(MyKey), UBound(MyKey, 2)) = MyLast

alors que MyKey est déclarée mais non dimensionnée ici :

Code:

Dim i As Long, MyKey, MySelection As String, MyTab(), n As Long

Puis dimensionnée en objet "Key" lors de sa première affectation ici :

Code:

For Each MyKey In MyDico.Keys

Or Ubound s'utilise pour obtenir la taille d'une variable tableau et pas d'un objet unique !!!
En effet ici Mykey repente un objet de la collection Keys... ou alors je suis passé à coté de quelque chose ?
16/01/2018, 13h02
tamtam64

pour la premiere reponse

bonjour,

merci pour ce retour mais je ne comprends pas ton message. Pour préciser ma demande, je ne comprend pas comment faire pour attribuer un tableau dans une plage de 2967 lignes et 9 colonnes. J'ai bien exactement le bon nombre de lignes et de colonnes debutant à 1 . Mais j'ai cette erreur, que je n'ai jamais eu en attribuant un vecteur à une plage.
16/01/2018, 13h08
tamtam64

Bonjour, Merci pour tyon retour,

Alors non tu es pas passé à coté de quelque chose mais c'est moi qui ai tellement essayé de truc que j'ai laissé des merdouilles. J'ai recorrigé le code tel qu'il etait au depart dans mon premier message .

Merci bcp pour ce retour en tout cas :)
16/01/2018, 13h09
pijaku

Qu'elle version d'Excel?

Parce que :
2967 lignes et 9 colonnes.

En fait c'est :
2967 colonnes et 9 lignes .
16/01/2018, 13h14
Phil Free

Bah dit nous ce que porte MyKey ! vu que cette variable n'est pas dimensionnée c'est plutôt difficile de comprendre le problème.

Faut bien comprendre qu'une variable à aussi ses limites et que ses limites dépendes de sont dimensionnement !
16/01/2018, 13h22
tamtam64

Citation:

Envoyé par Phil Free

Bah dit nous ce que porte MyKey ! vu que cette variable n'est pas dimensionnée c'est plutôt difficile de comprendre le problème.

Faut bien comprendre qu'une variable à aussi ses limites et que ses limites dépendes de sont dimensionnement !

MyKey ne rentre plus dans le probleme, j'ai corrigé le code tel qu'il etait au depart
16/01/2018, 13h23
tamtam64

Citation:

Envoyé par pijaku

Qu'elle version d'Excel?

Parce que :
2967 lignes et 9 colonnes.

En fait c'est :
2967 colonnes et 9 lignes .

excel version 2010, mais tu touches un bon point effectivement je vais creuser ca, ca pourrait être le probleme.

Sur une feuille vierge, dans un nouveau classeur, essaye ceci (tu devrais y déceler certaines choses...) :

Code:

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
Option Explicit
 
Sub essai()
Dim Tb(3, 2) As Long, a
'ta méthode :
Range("B2").Resize(UBound(Tb), UBound(Tb, 2)) = TransposeV(Tb)
 
'variante
a = TransposeV(Tb)
Range("E1").Resize(UBound(a), UBound(a, 2)) = a
End Sub
 
Function TransposeV(ByRef MyTab)
    Dim i As Long, j As Long, More As Byte
    Dim MyTabTrans()
 
    'redimentionnement
    If LBound(MyTab) = 0 Then More = 1 Else More = 0
    ReDim Preserve MyTabTrans(1 To UBound(MyTab, 2) + More, 1 To UBound(MyTab) + More)
 
    'Echange Lignes ==> Colonnes
    For i = LBound(MyTab) To UBound(MyTab)
        For j = LBound(MyTab, 2) To UBound(MyTab, 2)
            MyTabTrans(j + More, i + More) = MyTab(i, j)
        Next j
    Next i
 
    'Attribution
    TransposeV = MyTabTrans
End Function

16/01/2018, 13h35
tamtam64

J'ai fait ce que tu m'as dit mais en fait les deux methodes fonctionnent meme avec 3000 colonnes et 9 lignes ==> transposés en 9 colonnes et 3000 lignes

je continue de chercher
16/01/2018, 13h41
tamtam64

En fait ce que tu fais dans l'alternative, c'est ce que j'ai essayé de faire en attribuant la transposé dans MyKey et en attribuant MyKey à la plage redimensionné avec ubound de MyKey, mais ca marche pas. Pourtant dans ton test ca marche trés bien .... c'est incomprehensible
16/01/2018, 14h44
tamtam64

Probleme résolu, ca venait du contenu du tableau en effet je mettais des formules dedans et je devais mettre un ' devant avant de les coller. Merci