Discussion :

[apt]

Bonjour à tous,

J'aimerais avoir une aide pour optimiser une select case, pour ne pas avoir à répéter deux fois l'ouverture de même fichier pour écriture.

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
'---------------------------------------------------------
Option Explicit
 
Sub OuvreFich()
    Dim B$(), BB$(), Arr()
    Dim Reponse As Variant, Canal As Variant
    Dim Item
    Dim fName As String, A$
    Dim i As Byte, j As Byte, LastLg As Long, X As Long
 
    Application.ScreenUpdating = False
    Application.EnableEvents = False
 
    'On Error Resume Next
    Reponse = Application.GetOpenFilename _
              ("All Files (*.*),*.*")
 
    If Reponse = False Then Exit Sub
    Canal = FreeFile
    Open Reponse For Input As #Canal
 
    'Tableau des XAC
    Arr = Array("12", "15", "70", "33", "62")
    fName = "TPC "    ' Nom du fichier sous la forme : "TPC*.xls"
    Do While Not EOF(Canal)
        Line Input #Canal, A$
 
        If Len(Trim(A$)) > 0 Then    '-- Si la ligne est non vide
 
            If InStr(1, A$, "XAC") > 0 Then
                Line Input #Canal, A$
                X = 0
                Do While InStr(1, A$, "END") = 0
                    i = 0: j = 0
                    If Arr(X) = Mid(Trim(A$), 1, 2) Then
                        B$ = Split(Trim(A$), " ")
                        '-- Eliminer les vides du tableau B$
                        For Each Item In B$
                            If Len(Item) > 0 Then
                                ReDim Preserve BB$(j)
                                BB$(j) = B$(i)
                                j = j + 1
                            End If
                            i = i + 1
                        Next Item
                        Select Case Arr(X)
                        Case "12"
                            'ouvre PA
                            Workbooks.Open fName & "PA.xls"
                            '*-- 12 --
                            [E22] = [F22]: [F22] = BB$(2): [G22] = [H22]: [H22] = BB$(3)
                        Case "15"
                            'ouvre PA
                            Workbooks.Open fName & "PA.xls"
                            '-- 15 --
                            [E25] = [F25]: [F25] = BB$(2): [G25] = [H25]: [H25] = BB$(3)
                        Case "70"
                            'ouvre JCW
                            Workbooks.Open fName & "JCB.xls"
                            '-- 70 --
                            [E22] = [F22]: [F22] = BB$(2): [G22] = [H22]: [H22] = BB$(3)
 
                        Case "33"
                            'ouvre MSK
                            Workbooks.Open fName & "MSK.xls"
                            '*-- 33 --
                            [E22] = [F22]: [F22] = BB$(2): [G22] = [H22]: [H22] = BB$(3)
 
                        Case "62"
                            'ouvre MSK
                            Workbooks.Open fName & "MSK.xls"
                            '-- 62 --
                            [E25] = [F25]: [F25] = BB$(2): [G25] = [H25]: [H25] = BB$(3)
 
                        End Select
                    End If
                    Line Input #Canal, A$
                    X = X + 1
                Loop
            End If
        End If
    Loop
    On Error GoTo 0
End Sub
'------------------------------------------

Merci d'avance.

[SfJ5Rpw8]

bonsoir,

tu peu aussi ouvrir tes 3 fichiers ...


le principe..

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
dim wkPA as Workbook
set wkPA = Workbooks.Open (fName & "PA.xls")
(...)
 
Select 
(..)
with wkPA.Sheets("LeNomDeTAFEuille")
    .[E25] = .[F25]
end With
(...)

[apt]

Bonsoir bbil,

Un with dans un select déclenche une erreur de compilation :

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
Option Explicit
 
Sub OuvreFich()
    Dim B$(), BB$(), Arr()
    Dim Reponse As Variant, Canal As Variant
    Dim Item
    Dim fName As String, A$
    Dim i As Byte, j As Byte, LastLg As Long, X As Long
    Dim wkPA As Workbook, wkJCW As Workbook, wkMSK As Workbook
 
    'Tableau des XAC
    Arr = Array("12", "15", "70", "33", "62")
    fName = "TPC "    ' Nom du fichier sous la forme : "TPC*.xls"
 
    Set wkPA = Workbooks.Open(fName & "PA.xls")
    Set wkJCW = Workbooks.Open(fName & "JCW.xls")
    Set wkMSK = Workbooks.Open(fName & "MSK.xls")
 
 
 
 
    Application.ScreenUpdating = False
    Application.EnableEvents = False
 
    'On Error Resume Next
    Reponse = Application.GetOpenFilename _
              ("All Files (*.*),*.*")
 
    If Reponse = False Then Exit Sub
    Canal = FreeFile
    Open Reponse For Input As #Canal
 
 
    Do While Not EOF(Canal)
        Line Input #Canal, A$
 
        If Len(Trim(A$)) > 0 Then    '-- Si la ligne est non vide
 
            If InStr(1, A$, "XAC") > 0 Then
                Line Input #Canal, A$
                X = 0
                Do While InStr(1, A$, "END") = 0
                    i = 0: j = 0
                    If Arr(X) = Mid(Trim(A$), 1, 2) Then
                        B$ = Split(Trim(A$), " ")
                        '-- Eliminer les vides du tableau B$
                        For Each Item In B$
                            If Len(Item) > 0 Then
                                ReDim Preserve BB$(j)
                                BB$(j) = B$(i)
                                j = j + 1
                            End If
                            i = i + 1
                        Next Item
                        Select Case Arr(X)
                            With wkPA.Sheets("Feuil1")
                            Case "12"
                                'ouvre PA
                                '*-- 12 --
                                .[E22] = .[F22]: .[F22] = BB$(2): .[G22] = .[H22]: .[H22] = BB$(3)
                            Case "15"
                                'ouvre PA
                                '-- 15 --
                                .[E25] = .[F25]: .[F25] = BB$(2): .[G25] = .[H25]: .[H25] = BB$(3)
                            End With
 
                            With wkJCW.Sheets("Feuil1")
                            Case "70"
                                'ouvre JCW
                                '-- 70 --
                                .[E22] = .[F22]: .[F22] = BB$(2): .[G22] = .[H22]: .[H22] = BB$(3)
                            End With
 
                            With wkMSK.Sheets("Feuil1")
                            Case "33"
                                'ouvre MSK
                                '*-- 33 --
                                .[E22] = .[F22]: .[F22] = BB$(2): .[G22] = .[H22]: .[H22] = BB$(3)
 
                            Case "62"
                                'ouvre MSK
                                '-- 62 --
                                .[E25] = .[F25]: .[F25] = BB$(2): .[G25] = .[H25]: .[H25] = BB$(3)
                            End With
                        End Select
                    End If
                    Line Input #Canal, A$
                    X = X + 1
                Loop
            End If
        End If
    Loop
    On Error GoTo 0
End Sub

[did103]

Salut

Code :

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

1
2
3
4
5
With wkPA.Sheets("Feuil1")
Case "12"
'ouvre PA
'*-- 12 --
.[E22] = .[F22]: .[F22] = BB$(2): .[G22] = .[H22]: .[H22] = BB$(3)

Je n'ai pas essayé, mais je pense que ton With doit se trouver sous la valeur du Case:

Code :

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

1
2
3
4
5
Case "12"
'ouvre PA
'*-- 12 --
With wkPA.Sheets("Feuil1")
.[E22] = .[F22]: .[F22] = BB$(2): .[G22] = .[H22]: .[H22] = BB$(3)

Il faut donc dupliquer les With à mon avis, ce qui n'est pas très différent de l'Open.
Et même, en ouvrant tes 3 fichiers, tu dois ralentir l'opération...
Finalement, ta 1ère solution est sans doute meilleure...

[did103]

Peut-être peux-tu passer par un Case à plusieurs valeurs pour faire l'Open:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
Case "12","15"
'ouvre PA
Workbooks.Open fName & "PA.xls"
 
Case "12"
'*-- 12 --
[E22] = [F22]: [F22] = BB$(2): [G22] = [H22]: [H22] = BB$(3)
 
Case "15"
'-- 15 --
[E25] = [F25]: [F25] = BB$(2): [G25] = [H25]: [H25] = BB$(3)

Le Select va s'exécuter en séquentiel et traiter tous les Case qui le concernent, d'abord le Case groupé qui fait l'ouverture du fichier, puis la valeur simple qui fait le traitement.

[SfJ5Rpw8]

Peut-être peux-tu passer par un Case à plusieurs valeurs pour faire l'Open:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
Case "12","15"
'ouvre PA
Workbooks.Open fName & "PA.xls"
 
Case "12"
'*-- 12 --
[E22] = [F22]: [F22] = BB$(2): [G22] = [H22]: [H22] = BB$(3)
 
Case "15"
'-- 15 --
[E25] = [F25]: [F25] = BB$(2): [G25] = [H25]: [H25] = BB$(3)

Le Select va s'exécuter en séquentiel et traiter tous les Case qui le concernent, d'abord le Case groupé qui fait l'ouverture du fichier, puis la valeur simple qui fait le traitement.

Select ne fonctionne pas comme cela seule le premier cas est exécuté..

de plus travailler sur la feuille active ( notation [..]) n'est pas une bonne idée .. et souvent source de problème ..

Bonjour à tous,

J'aimerais avoir une aide pour optimiser une select case, pour ne pas avoir à répéter deux fois l'ouverture de même fichier pour écriture.
....

Et donc ta fonction est appelée plusieurs fois ?...
difficile sans connaitre le fonctionnement général de ton code de comprendre ou tu dois ouvrir et fermer tes fichiers......

dans mon code précédent j'utilisais une variable workbook .. mais tu peu aussi utiliser une variable Worksheet "pointant" sur la feuille concernée de ton classeur et ainsi limitant les with...

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Set wkMSK = Workbooks.Open(fName & "MSK.xls")
Set shMSK = wkMSK.Sheets("Feuil1")
(...)
 
shMSK.[E25] = shMSK.[F25]
 
(...)
 
 
'et pour fermer le classeur en sauvant..
wkMSK.close true

[did103]

Heureusement que BBIL est là...

Select ne fonctionne pas comme cela seule le premier cas est exécuté..

Pas d'exécution séquentielle du Select Case en VBA.
J'aurais pu tester avant... Je confonds avec un autre soft où l'on pouvait le faire, mais quoi???

Il reste toujours la solution de faire 2 Select Case, non?

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
 
Select Case Arr(X)
Case "12","15"
'ouvre PA
Workbooks.Open fName & "PA.xls"
Case "70"
'ouvre JCW
Workbooks.Open fName & "JCB.xls"
...
End Select
 
Select Case Arr(X)
Case "12"
'*-- 12 --
[E22] = [F22]: [F22] = BB$(2): [G22] = [H22]: [H22] = BB$(3)
 
Case "15"
'-- 15 --
[E25] = [F25]: [F25] = BB$(2): [G25] = [H25]: [H25] = BB$(3)
 
...
End Select

Suis d'accord sur la suite:

de plus travailler sur la feuille active ( notation [..]) n'est pas une bonne idée .. et souvent source de problème ..

code pas vraiment lisible...

[apt]

Bonsoir didi103,

Il reste toujours la solution de faire 2 Select Case, non?

Si C'est possible, j'aimerais réduire les lignes du code, mais pas en ajouter d'autres

code pas vraiment lisible...

Tu veux dire les :

[E22], [F22], ... etc ?

[apt]

Bonsoir,

Qu'en dites-vous de ce code ?

Il est bien optimiser ?

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
'---------------------------------------------------------
Option Explicit
Dim BB$()
Dim r As Boolean
Dim fName As String
Sub OuvreFich()
    Dim B$(), Arr()
    Dim Reponse As Variant, Canal As Variant
    Dim Item
    Dim A$
    Dim i As Byte, j As Byte, k As Byte, LastLg As Long, X As Long
    Dim wkPA As Workbook, wkJCW As Workbook, wkMSK As Workbook
 
    'Tableau des XAC
    Arr = Array("12", "15", "70", "33", "62")
    fName = "TPC "    ' Nom du fichier sous la forme : "TPC*.xls"
 
    Application.ScreenUpdating = False
    Application.EnableEvents = False
 
    'On Error Resume Next
    Reponse = Application.GetOpenFilename _
              ("All Files (*.*),*.*")
 
    If Reponse = False Then Exit Sub
    Canal = FreeFile
    Open Reponse For Input As #Canal
 
    ReDim BB$(4, 2)    ' 5 lignes et 3 colonnes
 
    Do While Not EOF(Canal)
        Line Input #Canal, A$
 
        If Len(Trim(A$)) > 0 Then    '-- Si la ligne est non vide
 
            If InStr(1, A$, " OAC") > 0 Then
                Line Input #Canal, A$
                Line Input #Canal, A$
                Line Input #Canal, A$
                X = 0
                Do While InStr(1, A$, "END") = 0
                    i = 0: j = 0
                    If Len(Mid(Trim(A$), 1, 2)) > 0 Then
                        If Not IsError(Application.Match(Mid(Trim(A$), 1, 2), Arr, 0)) Then
                            B$ = Split(Trim(A$), " ")
                            '-- Eliminer les vides du tableau B$
                            For Each Item In B$
                                If Len(Item) > 0 And Item <> "S" And j <= 2 Then
                                    BB$(X, j) = B$(i)
                                    j = j + 1
                                End If
                                i = i + 1
                            Next Item
                            X = X + 1
                        End If
                    End If
                    Line Input #Canal, A$
                Loop
            End If
        End If
    Loop
 
    For k = LBound(BB$) To UBound(BB$)
        Select Case BB$(k, 0)
        Case "12"
            Call OpenWriteF("PA", 0)
        Case "70"
            Call OpenWriteF("JCW", 2, False)
        Case "33"
            Call OpenWriteF("MSK", 3)
        End Select
    Next k
    'On Error GoTo 0
End Sub
'------------------------------------------
Sub OpenWriteF(f As String, L As Byte, Optional r As Boolean = True)
    Workbooks.Open fName & f & ".xls"
    With Sheets("feuil2")
        .[E22] = .[F22]: .[F22] = BB$(L, 1): .[G22] = .[H22]: .[H22] = BB$(L, 2)
        If r Then
            .[E25] = .[F25]: .[F25] = BB$(L + 1, 1): .[G25] = .[H25]: .[H25] = BB$(L + 1, 2):
        End If
    End With
End Sub

[SfJ5Rpw8]

comment veux-tu qu'on te reponde ?tu ne repond pas as nos questions... Que fais tu de ces fichiers ? En ouvre tu plusieurs simultanement? Comment les ferme tu?

[apt]

Bonsoir bbil,

Que fais tu de ces fichiers ? En ouvre tu plusieurs simultanement? Comment les ferme tu?

- Je l'ai ouvre pour insérer des valeurs récupérées d'un fichier texte, dans la ligne [F22] et [G22] de mes classeurs.

- Je l'ai ouvre à chaque cas rencontré (12, 15, 70, 33, 62)

C'est valeurs sont les noms de compteurs avec valeurs récupérées depuis le fichier texte.

- Dans le code dessus, je ne les ferme pas, parce qu'il reste à les imprimer.

Voila