XL 2013 Redim Preserve Variable Tableau Emboité = Erreur 9 (Indice hors plage)

laurent950

laurent950

XLDnaute Barbatruc
Bonsoir,
Ps : Pefixe Excel 2013 (Mais ce code est compatible toutes version Excel)
En Détaillant la problématique ci dessous :
* J'ai juste une ligne de code que je n'arrive pas à faire fonctionner.
' Indice hors plage (Erreur 9) --- Essayer de d'ajouter une colonne suplémentaire directement !
ReDim Preserve Cls_TabBase(LBound(TabBase(i), 1) To UBound(TabBase(i), 1), LBound(TabBase(i), 2) To UBound(TabBase(i), 2) + 1)
' Solution pour contourner se probléme :
TabTemp = TabBase(i)
ReDim Preserve TabTemp(LBound(TabTemp, 1) To UBound(TabTemp, 1), LBound(TabTemp, 2) To UBound(TabTemp, 2) + 1)
TabBase(i) = TabTemp

' Pour Voir l'anomalie et l'erreur dans le code :
Décoché la ligne en Rouge pour voir la ligne d'arret du code Bug erreur 9
ReDim Preserve Cls_TabBase(LBound(TabBase(i), 1) To UBound(TabBase(i), 1), LBound(TabBase(i), 2) To UBound(TabBase(i), 2) + 1)
ps : Elle est coché volontairement dans le code pour monter que cela fonctionne avec la solution de contournement.

' J'ai détailler tous le processe ci-dessous ! ainsi que le code que j'ai documenté.

' Ci-vous avez une idée avec un grand plaisir car je suis bloqué ici sur cette ligne qui devrait fonctionner !

VB: 
Option Base 1
Sub test()
Dim TabBase() As Variant
Dim TabTemp() As Variant
' Base et resultat
    ' Tableau 1 dimension de 57 Case "FiXE" = Aux 57 --> Index
        ' Dimension 1 Case (Avec Option Base 1) pour commencer à 1
            ReDim TabBase(1)
' Suite a cela je fais une boucle pour le nombre de colonne à Remplire (Soit 57)
    For i = 1 To 57
    ' Ici je m'arrete a la colonne Numéro 3 pour test (Ensuite je sort de la procédure for)
    If i > 3 Then Exit For
        ' Le but :
        '   Chacune de ces 57 Colonnes contiennent des nombres :
        '       * Chacune de ces colonnes ne sont pas de longeur fixe :
        '           * Exemple la colonne 1 = B aura par exemple 488 Lignes / Donc ligne 15  à 503
        '           * Exemple la colonne 2 = C aura par exemple 466 Lignes / Donc Ligne 37  à 503
        '           * Exemple la colonne 3 = D aura par exemple 377 Lignes / Donc Ligne 126 à 503
' le soucis = Une deuxiéme plage à récupérer
'       ' Explication = il y a une date pour chacunes des valeurs :
'       '   * Soit l'exemple ci-dessus :
'       '       * Exemple la colonne 1 = B aura par exemple 488 Lignes / Donc ligne 15  à 503
'       '           * deux plages :
'       '               '   Colonne A qui contient les dates et donc :
'       '               '   Plage aura date   488 Lignes / Donc ligne 15  à
'       '               '   Plage aura Valeur 488 Lignes / Donc ligne 15  à 503
' *****************************************************************************************************
'       '       * Exemple la colonne 2 = C aura par exemple 466 Lignes / Donc Ligne 37  à 503
'       '           * Même procéder que ci-dessus.
'******************************************************************************************************
' Suite du code
        ' Du haut Colone 1 = B pour i (Ligne 2) descente vers le bas (Premiere non vide = Depart du tableau)
            pr = Cells(Cells(2, i + 1).End(xlDown).Row, i + 1).Row
        ' Je consigne la premiere colonne comme l'exemple ci-dessus (Pour les dates) / Tojours la colonne 1
            TabBase(i) = Range(Cells(pr, 1), Cells(503, 1)) ' pr premiere non vide ligne 15
        ' ça y est j'ai mon premier tableau 2 dimension dans ma variable tableau 1 dimension
        '   Variable tableau 1 Dimension soit : TabBase
        '   Variable tableau 2 Dimension soit : TabBase(i)(1)
        ' A présent je veux Créer une seconde colonne de mon tableau 2 dimension (Pour y ajouter les valeurs)
        ' Donc
        ' avec redim preserve je vais y ajouter une colonne suplémentaire (Pour en avoir 2) au lieux d'une seule
        ' Pour Info
        ' debug.print LBound(TabBase)       / La premiere ligne   de mon tableau 1 dimension
        ' debug.print UBound(TabBase)       / La derniere ligne   de mon tableau 2 dimension
        ' debug.print LBound(TabBase(i), 1) / La premiere ligne   de mon tableau 2 dimension
        ' debug.print UBound(TabBase(i), 1) / La derniere ligne   de mon tableau 2 dimension
        ' debug.print LBound(TabBase(i), 2) / La premiere colonne de mon tableau 2 dimension
        ' debug.print UBound(TabBase(i), 2) / La derniere colonne de mon tableau 2 dimension
      
        ' Indice hors plage (Erreur 9) --- Essayer de d'ajouter une colonne suplémentaire directement !

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'
'                     CORRECTION : REDIM PRESERVE VARIABLE TABLEAU EMBOITE / Indice hors plage (Erreur 9)
'                     ReDim Preserve TabBase
'
'   ReDim Preserve TabBase(LBound(TabBase(i), 1) To UBound(TabBase(i), 1), LBound(TabBase(i), 2) To UBound(TabBase(i), 2) + 1)
'
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

        ' Solution transitoire à évité avec la ligne de code ci-dessus à faire fonctionner
        ' En attente ! Astuce de transfert
          
            TabTemp = TabBase(i)
            ReDim Preserve TabTemp(LBound(TabTemp, 1) To UBound(TabTemp, 1), LBound(TabTemp, 2) To UBound(TabTemp, 2) + 1)
            TabBase(i) = TabTemp
        ' Fin du transfert et l'ajout de la colonne suplémentaire
        ' Suite du code ci-dessous
        '   Etape pour Remplire la variable tableau (de la colone ajouté)
                For j = LBound(TabBase(i), 1) To UBound(TabBase(i), 1)
                    TabBase(i)(j, 2) = Cells(j + (pr - 1), i + 1)
                Next j
        ' Fin de remplissage du tableau 2 dimenssion avec respectivement :
        '   ' Une colonne date
        '   ' La colonne créer (En Attente d'astuce) avec les valeurs ajouté
        ' Création d'une nouvelle case du Tableau 1 dimension pour :
        '   * repeter les opération ci-dessus pour les 56 colonnes restantes (Respectivement avec les dates)
        ' Utilisation de Redim Preseve pour ajouter une nouvelle case a cette variable tableau
                ReDim Preserve TabBase(UBound(TabBase) + 1)
    Next i

' Suppression de la derniere case du tableau 1 dimension inutile
    ReDim Preserve TabBase(UBound(TabBase) - 1)
' FIN DU CODE

' Resultat
'       * 1 tableau 1 dimension de 57 Cases
'               * Chacune des cases contients un tableau 2 Dimensions.
End Sub

Merci Laurent
 

Pièces jointes

  • Redim Preserve Variables Tableaux Emboitées Erreur 9.xlsm
    34.7 KB · Affichages: 18
Solution
patricktoulon
regarde
demo4.gif
Trier par date Trier par votes
laurent950

laurent950

XLDnaute Barbatruc
Voici la solution du Poste #1
* Redim Preserve Variable Tableau Emboité = Erreur 9 (Indice hors plage)
* La solution : TabBase(i) = [{"","","",""}]

* Poste #20 (Solution pour copier des plages non contiguës

Le Code ci-dessous :
VB: 
Option Base 1
' Ici Astuce Redim Preserve
' Redimension de la premiere case du Tableau 1 D --->>> en Tableau 1 dimension de 4 cases
Sub test2()
Dim i As Integer: i = 1
Dim TabBase() As Variant
    ReDim TabBase(i)
' ici pour Application.Index ci-dessous
Dim arrcolumns As Variant
    For i = 1 To 57
    ' Redimension de la premiere case du Tableau 1 D --->>> en Tableau 1 dimension de 4 cases
    ' Ajouter des cases à TabBase(i) :
    ' Donc le TabBase(i) aura 4 Case
    ' Redim preserve TabBase(i)(1 to 4)                  = est Impossible
    ' 2 SOLUTIONS VOIR CI-DESSOUS :
    ' Soit Solution 1 : TabBase(i) = array([{"","","",""}]) = Possible je crée 4 Cases suplémentaires
    ' ici format du tableau = TabBase(1)(1)(1) / TabBase(1)(1)(2) / TabBase(1)(1)(3) / TabBase(1)(1)(4)
    ' Soit Solution 2: TabBase(i) = [{"","","",""} = Possible je crée 4 Cases suplémentaires
    ' ici format du tableau = TabBase(i)(1) / TabBase(i)(2) / TabBase(i)(3) / TabBase(i)(4)
    ' Soluction retenu la N°2 :
        TabBase(i) = [{"","","",""}]
    ' Donc
        TabBase(i)(1) = "BT01"
        TabBase(i)(2) = Array("Janvier", "Fevrier", "Mars", "Etc.")
        TabBase(i)(3) = Array("1974", "1975", "1976", "Etc.")
    ' Suite
        pr = Cells(Cells(2, i + 1).End(xlDown).Row, i + 1).Row
    ' Copier des Colonne Non Contiguës
        With Range(Cells(pr, 1), Cells(503, i + 1))
             arrcolumns = Array(1, i + 1)
             TabBase(i)(4) = Application.Index(.Value, Evaluate("ROW(1:" & .Rows.Count & ")"), arrcolumns)
        End With
    ' Remimension du Tableau 1 Dimension
        ReDim Preserve TabBase(UBound(TabBase) + 1)
    Next i
' Suppresion de la derniere case du tableau 1 Dimension
ReDim Preserve TabBase(UBound(TabBase) - 1)
' Par la suite je vais faire le complément pour la lecture.
' Suite ici a venir ..................
End Sub

Le reste fonctionne
Merci pour l'explication de la Multipage sur l'Userform Patrick
Pour la Multipage l'index est bien 0 pour la premiere page (La page 1)
Merci encore
Laurent
 
Dernière édition:
Vote positif 0 Vote négatif
laurent950

laurent950

XLDnaute Barbatruc
Fichier Remplacer le 20/04/2020
Fichier : V11_Travail sur Index VBA-19-04-2020 - Copie

Pour Patricktoulon

VB: 
Idée avec un Dictionary une structure
Sub DicoDoublonSommeLaurent950()
' https://www.excel-downloads.com/threads/transfer-et-trie-dune-feuil-a-une-autre-feuil-meme-classeur.20049927/
Dim TI As Single
'    TI = Timer
' ***************************************************
'Dim d As New Scripting.Dictionary
Dim d As Object
    Set d = CreateObject("Scripting.Dictionary")
    d.CompareMode = TextCompare
Dim cef As String
' ***************************************************
Dim Tb() As Variant
Dim ShF1 As Worksheet
    Set ShF1 = Worksheets("BDD")
    Tb = ShF1.Range(ShF1.Cells(2, 1), ShF1.Cells(ShF1.Cells(65536, 5).End(xlUp).Row, 112))
Dim i, j, cpt As Double
' ***************************************************
Dim tabDico() As Variant
ReDim tabDico(0)
Dim TabRes() As Variant
ReDim TabRes(1 To 8, 1 To 1)
Dim Temp() As Variant
' ***************************************************
Dim ShF2 As Worksheet
    Set ShF2 = Worksheets("TrieparIGC")
    'ShF2.Range(ShF2.Cells(2, 5), ShF2.Cells(ShF2.Cells(65536, 5).End(xlUp).Row + 1, 30)).Interior.Pattern = xlNone
    'ShF2.Range(ShF2.Cells(2, 5), ShF2.Cells(ShF2.Cells(65536, 5).End(xlUp).Row + 1, 30)).ClearContents
' ***************************************************
    For i = LBound(Tb) + 1 To UBound(Tb) ' Commence à la ligne 2 (LBound(Tb) + 1)
        clef = Tb(i, 12)
            If d.Exists(clef) Then
            cpt = d(clef)
            Temp = tabDico(cpt - 1)
            ReDim Preserve Temp(1 To 8, 1 To UBound(Temp, 2) + 1)
            tabDico(cpt - 1) = Temp
                tabDico(cpt - 1)(1, UBound(Temp, 2)) = Tb(i, 4)
                tabDico(cpt - 1)(2, UBound(Temp, 2)) = Tb(i, 5)
                tabDico(cpt - 1)(3, UBound(Temp, 2)) = Tb(i, 6)
                tabDico(cpt - 1)(4, UBound(Temp, 2)) = Tb(i, 18)
                tabDico(cpt - 1)(5, UBound(Temp, 2)) = Tb(i, 19)
                tabDico(cpt - 1)(6, UBound(Temp, 2)) = Tb(i, 12)
                tabDico(cpt - 1)(7, UBound(Temp, 2)) = Tb(i, 112)
                tabDico(cpt - 1)(8, UBound(Temp, 2)) = Tb(i, 95)
            Erase Temp
        Else
            cpt = d.Count + 1
            d(clef) = cpt
            tabDico(cpt - 1) = TabRes
                tabDico(cpt - 1)(1, 1) = Tb(i, 4)
                tabDico(cpt - 1)(2, 1) = Tb(i, 5)
                tabDico(cpt - 1)(3, 1) = Tb(i, 6)
                tabDico(cpt - 1)(4, 1) = Tb(i, 18)
                tabDico(cpt - 1)(5, 1) = Tb(i, 19)
                tabDico(cpt - 1)(6, 1) = Tb(i, 12)
                tabDico(cpt - 1)(7, 1) = Tb(i, 112)
                tabDico(cpt - 1)(8, 1) = Tb(i, 95)
            ReDim Preserve tabDico((cpt - 1) + 1)
        End If
    Next i
' Suppression de la derniere dimension
    ReDim Preserve tabDico(UBound(tabDico) - 1)
' Boucle sur tabDico
    cpt = 4
    For i = LBound(tabDico) To UBound(tabDico)
        For j = 1 To 7
            ShF2.Cells(cpt, j + 1).Resize(UBound(tabDico(i), 2), 1) = Application.Index(Application.Transpose(tabDico(i)), , j)
        Next j
            ShF2.Cells(cpt, 12).Resize(UBound(tabDico(i), 2), 1) = Application.Index(Application.Transpose(tabDico(i)), , 8)
    cpt = ShF2.Cells(65536, 2).End(xlUp).Row + 1
    Next i
'MsgBox Format(Timer - TI, "0.000\ sec.")
End Sub
 

Pièces jointes

  • V11_Travail sur Index VBA-19-04-2020 - Copie.xlsm
    228.3 KB · Affichages: 9
Dernière édition:
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
allez ca commence
Capture.JPG


et ca continue
demo4.gif



bon malgré les erreur de combo passage(annuelle/etre deux dates
je crois comprendre que tu choisi les deux date et tu fait un calcul entre les deux c'est ca ?
Capture.JPG

ma fois si tu a fait tout ce ramdam pour ça le confinement t'a beaucoup plus amoché que le virus
;) ;)
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

A
  • Question
XL 2019 Redimensionnement dynamique d'une matrice
Réponses
6
Affichages
136
amgue
A
cathodique
  • Résolu(e)
XL 2010 Erreur de compilation - Incompatibilité de type: tableau ou type défini par l'utilisateur
Réponses
3
Affichages
210
cathodique
cathodique
cathodique
  • Résolu(e)
XL 2010 Mauvaise utilisation de la fonction InStr
Réponses
11
Affichages
617
jurassic pork
jurassic pork
cathodique
  • Question
XL 2010 Code de l'IA à corriger
2 3
Réponses
33
Affichages
2 K
cathodique
cathodique
cathodique
  • Résolu(e)
XL 2010 Créer ListObject + Ligne Total
2
Réponses
16
Affichages
666
dysorthographie
dysorthographie
cathodique
  • Question
XL 2010 Nb occurences non juste
Réponses
5
Affichages
490
mapomme
mapomme
cathodique
  • Question
XL 2010 Comptage Complexe
2 3
Réponses
40
Affichages
2 K
dysorthographie
dysorthographie
C
  • Résolu(e)
XL 2016 VBA : inversion de Date sur Range.Resize ... = Tableau après Transpose du Tableau
Réponses
2
Affichages
178
crocrocro
C
patricktoulon
  • Question
Autres la fonction similaire
Réponses
11
Affichages
432
patricktoulon
patricktoulon
A
  • Question
VBA qui fonctionnait avant, mais ne fonctionne plus avec le 64 bits
Réponses
2
Affichages
136
patricktoulon
patricktoulon

Membres actuellement en ligne

2 membres et 27 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 087
Messages
2 116 084
Membres
112 655
dernier inscrit
fannycordi