Discussion :

[Thallhos]

Bien le bonjour au forum,

Je viens vers vous pour une problématique auquelle je fais face et qui dépasse mes compétences, l'optimisation d'un code qui fonctionne parfaitement, seulement lorsque la cible est une base donnée un peu plus grosse mon code ram et ne finit jamais.

J'ai mis des pauses de 6 secondes pour attendre l'ouverture de mon fichier mais rien y fait il continue de rammer, est-ce que l'un d'entre vous aurait une petite idée ou un lien pour m'aiguiller ? (j'ai rien trouvé sur internet )

Ci après mon code :

D'abord le code de mon userform :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub CommandButton1_Click()
fileToOpen = Application.GetOpenFilename(, , "file explorer")
If fileToOpen <> False Then
Expat_way.Value = fileToOpen
End If
End Sub
Private Sub CommandButton2_Click()
Call Import_Nat
Unload Me
End Sub
Private Sub CommandButton3_Click()
Unload Me
End Sub

Puis celui de ma macro :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
Sub Import_Nat()
With UF_Import_Nat
    'control
    If .Expat_way.Value = "" Then
        Message = "Could you select a file !"
        .Expat_way.SetFocus
        Exit Sub
    End If
fileToOpen2 = .Expat_way.Value
End With
 
Application.EnableEvents = False
Application.ScreenUpdating = False
Feuil7.Cells.Clear
 
Dim Expat_WB As Workbook
Dim Myfile As String
Dim Answer As Long
 
Myfile = "fileToOpen2"
Verif = IsFileOpen(Myfile)
 
If Verif = True Then
    Answer = MsgBox("The National allocation file is already opened, do you want to extract from the opened version ?", vbYesNo, "WARNING : File already opened")
    Select Case Answer
        Case vbYes
            Set Expat_WB = GetObject(fileToOpen2)
 
            Application.Wait (Now + TimeValue("0:00:06"))
            With Expat_WB
            Application.CutCopyMode = False
            .Sheets("Staff list").Cells.Copy
            End With
 
            ThisWorkbook.Activate
            Feuil7.Activate
            Range("A1").Select
            With Selection
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            End With
 
            Application.CutCopyMode = False
 
            Application.ScreenUpdating = True
            Range("A1").Select
            Feuil1.Activate
 
            Expat_WB.Close (True)
            MsgBox ("National allocation imported")
 
        Case vbNo
            Workbooks.Open Filename:=fileToOpen2
            'corriger erreur si déjà ouvert = trouver code correspondant
            Set Expat_WB = GetObject(fileToOpen2)
 
            Application.Wait (Now + TimeValue("0:00:06"))
            With Expat_WB
            Application.CutCopyMode = False
            .Sheets("Staff list").Cells.Copy
            End With
 
            ThisWorkbook.Activate
            Feuil7.Activate
            With Selection
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            End With
 
            Application.CutCopyMode = False
 
            Application.ScreenUpdating = True
            Range("A1").Select
            Feuil1.Activate
 
            Expat_WB.Close (True)
            MsgBox ("National allocation imported")
    End Select
 
Else
    Workbooks.Open Filename:=fileToOpen2
 
    Set Expat_WB = GetObject(fileToOpen2)
 
            Application.Wait (Now + TimeValue("0:00:06"))
            With Expat_WB
            Application.CutCopyMode = False
            .Sheets("Staff list").Cells.Copy
            End With
 
    ThisWorkbook.Activate
    Feuil7.Activate
    Range("A1").Select
    With Selection
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteFormats
    End With
 
    Application.CutCopyMode = False
 
    Application.ScreenUpdating = True
    Range("A1").Select
    Feuil1.Activate
    Range("C20").Value = Date
    Expat_WB.Close (True)
    MsgBox ("National allocation imported")
End If
Application.EnableEvents = True
End Sub

Un très grand merci d'avance pour vos éclairages.

Bien cordialement,

Thallhos

[joe.levrai]

Bonjour,

plutôt que de copier TOUTES les cellules de la feuille, ne pourrais-tu pas restreindre à la plage utile (UsedRange) ou carrément copier cette feuille ?

Si le fichier est très lourd, malheureusement il n'y a pas de méthode miracle pour son ouverture, faut charger en mémoire tout son contenu

à moins de rappartrier les éléments en faisait une requête sur classeur fermé, mais tu perdras toutes les mises en formes

[Thallhos]

Bonjour,

plutôt que de copier TOUTES les cellules de la feuille, ne pourrais-tu pas restreindre à la plage utile (UsedRange) ou carrément copier cette feuille ?

Si le fichier est très lourd, malheureusement il n'y a pas de méthode miracle pour son ouverture, faut charger en mémoire tout son contenu

à moins de rappartrier les éléments en faisait une requête sur classeur fermé, mais tu perdras toutes les mises en formes

Hello Joe,

Je te remercie de ta réponse, en fait les informations contenues dans cette feuille sont liées à des formules excel dans d'autres onglets, donc je veux surtout pas créer de nouvelle feuille, et les données ne sont pas fixes c'est une base de données donc mise à jour tout les mois et sa taille change.

Je vais essayer de sélectionner toutes les lignes jusqu'à la dernière non vide, je te fais un retour asap


Merci encore,

Thal

[Thallhos]

Hello Joe,

Je te remercie de ta réponse, en fait les informations contenues dans cette feuille sont liées à des formules excel dans d'autres onglets, donc je veux surtout pas créer de nouvelle feuille, et les données ne sont pas fixes c'est une base de données donc mise à jour tout les mois et sa taille change.

Je vais essayer de sélectionner toutes les lignes jusqu'à la dernière non vide, je te fais un retour asap


Merci encore,

Thal

Okay, je viens de tester, c'est moins beau visuellement mais ca fonctionne, merci encore !!

Bonne journée

Thal