XL 2013 Erreur d'exécution 9 ou 13 que je n'arrive pas à résoudre.

massol

XLDnaute Junior
Bonjour,

Que fait ma procédure ?

Avec la première boucle je mets en mémoire à l'aide d'un tableau (Tab_data) la totalité de la base de données (50 colonnes et presque 400 000 lignes contenues dans le fichier "schema.xml_temporary.xlsx") et avec la deuxième boucle je n'extrais que les lignes qui m'intéressent (celles qui contiennent "report" dans les cellules situées à une certaine colonne... ) et enfin je les récupère dans ma feuille EXCEL.

A l'exécution de ma procédure j'ai le message suivant :

Nom : Capture1.JPG Affichages : 8 Taille : 18,0 Ko


Voici ma procédure complète :

VB:
Sub macro()
'
Dim derniere_ligne As Long
Dim i As Long
Dim Dossier_racine As String
'
'Saisie du dossier racine (valeur par défaut "P:\EXPORT"
Dossier_racine = InputBox("Select the folder where the database is located", "Data base folder", "P:\EXPORT")
'
'------ ON OUVRE LE FICHIER "schema.xml_temporary.xlsx" ET ON VA DANS L'ONGLET "schema.xml_temporary" ------
'
Workbooks.Open Filename:=Dossier_racine & "\" & "schema.xml_temporary.xlsx"
Sheets("schema.xml_temporary").Activate
'
'Recherche du numéro de la dernière ligne
'
derniere_ligne = Range("A1").End(xlDown).Row
'
'MsgBox ("Dernière ligne = ") & derniere_ligne
'
MsgBox ("The storage of the database will begin")
'
Tab_data = Range(Cells(1, 1), Cells(derniere_ligne - 2, 50)).Value
'
'
'Enregistrement des valeurs dans le tableau
    For i = 0 To derniere_ligne - 2
 
        Tab_data(i, 0) = Range("A" & i + 2)
        Tab_data(i, 1) = Range("B" & i + 2)
        Tab_data(i, 2) = Range("C" & i + 2)
        Tab_data(i, 3) = Range("D" & i + 2)
        Tab_data(i, 4) = Range("E" & i + 2)
        Tab_data(i, 5) = Range("F" & i + 2)
        Tab_data(i, 6) = Range("G" & i + 2)
        Tab_data(i, 7) = Range("H" & i + 2)
        Tab_data(i, 8) = Range("I" & i + 2)
        Tab_data(i, 9) = Range("J" & i + 2)
        Tab_data(i, 10) = Range("K" & i + 2)
        Tab_data(i, 11) = Range("L" & i + 2)
        Tab_data(i, 12) = Range("M" & i + 2)
        Tab_data(i, 13) = Range("N" & i + 2)
        Tab_data(i, 14) = Range("O" & i + 2)
        Tab_data(i, 15) = Range("P" & i + 2)
        Tab_data(i, 16) = Range("Q" & i + 2)
        Tab_data(i, 17) = Range("R" & i + 2)
        Tab_data(i, 18) = Range("S" & i + 2)
        Tab_data(i, 19) = Range("T" & i + 2)
        Tab_data(i, 20) = Range("U" & i + 2)
        Tab_data(i, 21) = Range("V" & i + 2)
        Tab_data(i, 22) = Range("W" & i + 2)
        Tab_data(i, 23) = Range("X" & i + 2)
        Tab_data(i, 24) = Range("Y" & i + 2)
        Tab_data(i, 25) = Range("Z" & i + 2)
        Tab_data(i, 26) = Range("AA" & i + 2)
        Tab_data(i, 27) = Range("AB" & i + 2)
        Tab_data(i, 28) = Range("AC" & i + 2)
        Tab_data(i, 29) = Range("AD" & i + 2)
        Tab_data(i, 30) = Range("AE" & i + 2)
        Tab_data(i, 31) = Range("AF" & i + 2)
        Tab_data(i, 32) = Range("AG" & i + 2)
        Tab_data(i, 33) = Range("AH" & i + 2)
        Tab_data(i, 34) = Range("AI" & i + 2)
        Tab_data(i, 35) = Range("AJ" & i + 2)
        Tab_data(i, 36) = Range("AK" & i + 2)
        Tab_data(i, 37) = Range("AL" & i + 2)
        Tab_data(i, 38) = Range("AM" & i + 2)
        Tab_data(i, 39) = Range("AN" & i + 2)
        Tab_data(i, 40) = Range("AO" & i + 2)
        Tab_data(i, 41) = Range("AP" & i + 2)
        Tab_data(i, 42) = Range("AQ" & i + 2)
        Tab_data(i, 43) = Range("AR" & i + 2)
        Tab_data(i, 44) = Range("AS" & i + 2)
        Tab_data(i, 45) = Range("AT" & i + 2)
        Tab_data(i, 46) = Range("AU" & i + 2)
        Tab_data(i, 47) = Range("AV" & i + 2)
        Tab_data(i, 48) = Range("AW" & i + 2)
        Tab_data(i, 49) = Range("AX" & i + 2)
        Tab_data(i, 50) = Range("AY" & i + 2)
    Next
'
'Fin de mise en mémoire
'
'Fermeture du fichier "schema.xml_temporary.xlsx" sans sauvegarder
'
Workbooks("schema.xml_temporary.xlsx").Close False
'
MsgBox ("Data extraction will begin")
'
'Extraction des lignes
'
For i = 0 To derniere_ligne - 2
'
If Tab_data(i, 21) Like "*report*" Then
'
    Cells(i + 2, 1) = Tab_data(i, 0)
    Cells(i + 2, 2) = Tab_data(i, 1)
    Cells(i + 2, 3) = Tab_data(i, 2)
    Cells(i + 2, 4) = Tab_data(i, 3)
    Cells(i + 2, 5) = Tab_data(i, 4)
    Cells(i + 2, 6) = Tab_data(i, 5)
    Cells(i + 2, 7) = Tab_data(i, 6)
    Cells(i + 2, 8) = Tab_data(i, 7)
    Cells(i + 2, 9) = Tab_data(i, 8)
    Cells(i + 2, 10) = Tab_data(i, 9)
    Cells(i + 2, 11) = Tab_data(i, 10)
    Cells(i + 2, 12) = Tab_data(i, 11)
    Cells(i + 2, 13) = Tab_data(i, 12)
    Cells(i + 2, 14) = Tab_data(i, 13)
    Cells(i + 2, 15) = Tab_data(i, 14)
    Cells(i + 2, 16) = Tab_data(i, 15)
    Cells(i + 2, 17) = Tab_data(i, 16)
    Cells(i + 2, 18) = Tab_data(i, 17)
    Cells(i + 2, 19) = Tab_data(i, 18)
    Cells(i + 2, 20) = Tab_data(i, 19)
    Cells(i + 2, 21) = Tab_data(i, 20)
    Cells(i + 2, 22) = Tab_data(i, 21)
    Cells(i + 2, 23) = Tab_data(i, 22)
    Cells(i + 2, 24) = Tab_data(i, 23)
    Cells(i + 2, 25) = Tab_data(i, 24)
    Cells(i + 2, 26) = Tab_data(i, 25)
    Cells(i + 2, 27) = Tab_data(i, 26)
    Cells(i + 2, 28) = Tab_data(i, 27)
    Cells(i + 2, 29) = Tab_data(i, 28)
    Cells(i + 2, 30) = Tab_data(i, 29)
    Cells(i + 2, 31) = Tab_data(i, 30)
    Cells(i + 2, 32) = Tab_data(i, 31)
    Cells(i + 2, 33) = Tab_data(i, 32)
    Cells(i + 2, 34) = Tab_data(i, 33)
    Cells(i + 2, 35) = Tab_data(i, 34)
    Cells(i + 2, 36) = Tab_data(i, 35)
    Cells(i + 2, 37) = Tab_data(i, 36)
    Cells(i + 2, 38) = Tab_data(i, 37)
    Cells(i + 2, 39) = Tab_data(i, 38)
    Cells(i + 2, 40) = Tab_data(i, 39)
    Cells(i + 2, 41) = Tab_data(i, 40)
    Cells(i + 2, 42) = Tab_data(i, 41)
    Cells(i + 2, 43) = Tab_data(i, 42)
    Cells(i + 2, 44) = Tab_data(i, 43)
    Cells(i + 2, 45) = Tab_data(i, 44)
    Cells(i + 2, 46) = Tab_data(i, 45)
    Cells(i + 2, 47) = Tab_data(i, 46)
    Cells(i + 2, 48) = Tab_data(i, 47)
    Cells(i + 2, 49) = Tab_data(i, 48)
    Cells(i + 2, 50) = Tab_data(i, 49)
    Cells(i + 2, 51) = Tab_data(i, 50)
'
  Else
'
End If
'
Next
'
Range("A1").Select
'
MsgBox ("Data extraction completed")
'
End Sub

Je précise que j'ai ce message depuis que j'ai remplacé :

VB:
Dim Tab_ECM()
ReDim Tab_ECM(derniere_ligne - 2, 50)

par

VB:
derniere_ligne = Range("A1").End(xlDown).Row
Tab_ECM = Range(Cells(1, 1), Cells(derniere_ligne - 2, 50)).Value

Dans la première version de mon code (celle avec les commandes dim et Redim) j'avais à l’exécution le message suivant :

1029414


Dans ce cas le pb viendrait de la ligne suivante :

VB:
If Tab_data(i, 21) Like "*report*" Then
Je patauge depuis un moment sur ce sujet..... Des suggestions ? Merci par avance.

Cdlt.
Jérôme
 

eriiic

XLDnaute Barbatruc
Franchement, vraiment besoin d'une charte ?
S'ils sont normalement constitués, il doivent bien se rendent compte du coté égoïste et non respectueux des helpers à procéder ainsi.
Au pire, quand il n'aura plus de réponse car les gens en auront marres d'avoir perdu du temps sur un truc résolu depuis plusieurs heures ailleurs, ou bien à avoir exposé les mêmes explications déjà postées ailleurs, ça lui ouvrira les yeux ;-)
eric
 

vgendron

XLDnaute Barbatruc
Hello all :-D

et ce code ?
VB:
Sub macro()

Dim derniere_ligne As Long
Dim i As Long
Dim statusBarInitial As Long
Dim Dossier_racine As String
Dim Tab_data() As Variant

'Saisie du dossier racine (valeur par défaut "P:\EXPORT"
Dossier_racine = InputBox("Select the folder where the database is located", "Data base folder", "P:\EXPORT")

'------ ON OUVRE LE FICHIER "schema.xml_temporary.xlsx" ET ON VA DANS L'ONGLET "schema.xml_temporary" ------
Workbooks.Open Filename:=Dossier_racine & "\" & "schema.xml_temporary.xlsx"
Sheets("schema.xml_temporary").Activate

'Recherche du numéro de la dernière ligne
derniere_ligne = Range("A" & Rows.Count).End(xlUp).Row
MsgBox ("Dernière ligne = ") & derniere_ligne
MsgBox ("The storage of the database will begin")

Tab_data = Range("A2").Resize(derniere_ligne - 1, 51).Value
'Fermeture du fichier "schema.xml_temporary.xlsx" sans sauvegarder
Workbooks("schema.xml_temporary.xlsx").Close False
'
MsgBox ("Data extraction will begin")

'Extraction des lignes pour lesquelles "*Report*" apparait en 22ème colonne
'
For i = LBound(Tab_data, 1) To UBound(Tab_data, 1) - 2 '-2 pour éviter de sortir du tableau==> si les deux dernières lignes contiennent Report: elles ne seront pas traitées
'==> faire un tableau de derniere_Ligne + 2 ==> et donc faire la boucle jusqu'à "Ubound(Tab_Data,1)
    If UCase(Tab_data(i, 22)) Like "*REPORT*" Then
        For j = LBound(Tab_data, 2) To UBound(Tab_data, 2)
            Tab_data(i + 2, j) = Tab_data(i, j) 'on travaille directement dans le tableau.. beaucoup plus rapide.. et c'est tout l'intérêt d'un tableau
        Next j
    End If
Next i
'
Range("A2").Resize(UBound(Tab_data, 1), UBound(Tab_data, 2)) = Tab_data 'on colle le tableau dans la feuille
'
MsgBox ("Data extraction completed")
'
End Sub
 

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour le fil, bonjour le forum,

Mon premier code ne fonctionnait pas car il ne prenait pas en compte la bonne colonne (21 au lieu de 22 !?). Le voici modifié et commenté :
Macro qui va prendre pas mal de temps à s'exécuter vu le grand nombre de lignes...

VB:
Sub Macro1()
Dim OE As Worksheet 'déclare la variable OE (Onglet Extraction)
Dim Dossier_racine As String
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim Tab_data As Variant 'déclare la variable Tab_data
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Application.ScreeUpdating = False 'masque les rafraîchissements d'écran
Set OE = ActiveSheet 'définit l'onglet de l'extraction OE
Dossier_racine = InputBox("Select the folder where the database is located", "Data base folder", "P:\EXPORT") 'boîte d'entrée
Workbooks.Open Filename:=Dossier_racine & "\" & "schema.xml_temporary.xlsx" 'ouvre le fichier source
Set OS = ActiveWorkbook.Sheets("schema.xml_temporary") 'définit l'onglet source
MsgBox ("The storage of the database will begin") 'message
Tab_data = OS.Range("A1").CurrentRegion 'définit le tableau Tab_data
Workbooks("schema.xml_temporary.xlsx").Close False 'ferme le fichier source
MsgBox ("Data extraction will begin") 'message
For I = 2 To UBound(Tab_data, 1) 'boucle sur toutes les lignes I du tableau Tab_data (en partant de la seconde)
    If InStr(1, Tab_data(I, 22), "report", vbTextCompare) > 0 Then 'condition : si la donnée en ligne I colonne 22 de Tab_data contient "report"
        Set DEST = OE.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
        DEST.Resize(1, UBound(Tab_data, 2)).Value = Application.Index(Tab_data, I) 'renvoie dans DEST redimensionnée la ligne I du tableau Tab_data
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
OE.Range("A1").Select 'sélectionne la cellule A1 de l'onglet OE
Application.ScreeUpdating = True 'affiche les rafraîchissements d'écran
MsgBox ("Data extraction completed") 'message
End Sub
 
Dernière édition:

Statistiques des forums

Discussions
313 277
Messages
2 096 762
Membres
106 745
dernier inscrit
Krisbret