Correction d'une SELECT CASE

Le
Apitos
Bonjour à tous,

Dans le code suivant, j'aimerais corriger une SELECT CASE qu'elle contient =
des tâches qui se répètent.

Ainsi, j'aimerais définir les variables suivantes, parce que j'ai essay=
é de trouver quel type elles appartiennent sans succès (Alors j'ai comm=
enté Option Explicit) :

- (Reponse) et (Canal)

'
'Option Explicit

Sub OuvreFich()
Dim B$(), BB$(), Arr()
'Dim Reponse As Boolean, Canal As String
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] = [H=
22]: [H22] = BB$(3)
Case "15"
'ouvre PA
Workbooks.Open fName & "PA.xls"
'-- 15 --
[E22] = [F22]: [F22] = BB$(2): [G22] = [H=
22]: [H22] = BB$(3)
Case "70"
'ouvre JCW
Workbooks.Open fName & "JCB.xls"
'-- 70 --
[E22] = [F22]: [F22] = BB$(2): [G22] = [H=
22]: [H22] = BB$(3)

Case "33"
'ouvre MSK
Workbooks.Open fName & "MSK.xls"
'*-- 33 --
[E22] = [F22]: [F22] = BB$(2): [G22] = [H=
22]: [H22] = BB$(3)

Case "62"
'ouvre MSK
Workbooks.Open fName & "MSK.xls"
'-- 62 --
[E22] = [F22]: [F22] = BB$(2): [G22] = [H=
22]: [H22] = 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.
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
isabelle
Le #24529211
bonjour,

Dim Reponse As Variant, Canal As Variant

--
isabelle



Le 2012-06-01 19:48, Apitos a écrit :
Bonjour à tous,

Dans le code suivant, j'aimerais corriger une SELECT CASE qu'elle contient des tâches qui se répètent.

Ainsi, j'aimerais définir les variables suivantes, parce que j'ai essayé de trouver quel type elles appartiennent



sans succès (Alors j'ai commenté Option Explicit) :

- (Reponse) et (Canal)

Apitos
Le #24529421
Bonjour Isabelle,

Dim Reponse As Variant, Canal As Variant



Peut-on les définir par leurs vrai type de variable ?
Apitos
Le #24529461
Re,

Une petite correction dans le select case (il s'agit de la ligne 22 et 25 d ans les fichier à ouvrir et non pas seulement la ligne 22) :

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

Case "33"
'ouvre MSK
Workbooks.Open fName & "MSK.xls"
'*-- 33 --
[E22] = [F22]: [F22] = BB$(2): [G22] = [H 22]: [H22] = BB$(3)

Case "62"
'ouvre MSK
Workbooks.Open fName & "MSK.xls"
'-- 62 --
[E25] = [F25]: [F25] = BB$(2): [G25] = [H 25]: [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
'------------------------------------------
Apitos
Le #24532151
Bonjour,

Une solution possible ?

Merci.
MichD
Le #24532901
Bonjour,

Une suggestion, tu devrais soigner la présentation de tes questions.

Perso., je ne vais pas me mettre à compter le nombre de lignes dans une
procédure.
Je ne vais pas me demander si dans le décompte on doit tenir compte des
lignes vides ou non.

Par contre, si tu identifies clairement la ligne de code qui pose problème
et en quoi
elle est problématique, tu as plus de chance de recevoir une réponse
adéquate.

Ce sont des bénévoles qui répondent. À ce titre, ils s'attendent à ce que le
demandeur
fasse un effort pour exprimer clairement leur demande.
Apitos
Le #24535971
Bonsoir Denis,

Il y a des tâches qui se répètent (Ouverture des mêmes fichiers, Ec riture dans les mêmes cellules) et j'aimerais bien optimiser le code suiv ant si c'est possible :

Select Case Arr(X)
Case "12"
'ouvre PA
Workbooks.Open fName & "PA.xls"
'*-- 12 --
[E22] = [F22]: [F22] = BB$(2): [G22] = [H 22]: [H22] = BB$(3)
Case "15"
'ouvre PA
Workbooks.Open fName & "PA.xls"
'-- 15 --
[E25] = [F25]: [F25] = BB$(2): [G25] = [H 25]: [H25] = BB$(3)
Case "70"
'ouvre JCB
Workbooks.Open fName & "JCB.xls"
'-- 70 --
[E22] = [F22]: [F22] = BB$(2): [G22] = [H 22]: [H22] = BB$(3)

Case "33"
'ouvre MSK
Workbooks.Open fName & "MSK.xls"
'*-- 33 --
[E22] = [F22]: [F22] = BB$(2): [G22] = [H 22]: [H22] = BB$(3)

Case "62"
'ouvre MSK
Workbooks.Open fName & "MSK.xls"
'-- 62 --
[E25] = [F25]: [F25] = BB$(2): [G25] = [H 25]: [H25] = BB$(3)
End Select


Merci.
h2so4
Le #24536021
Le samedi 2 juin 2012 01:48:22 UTC+2, Apitos a écrit :
Bonjour à tous,

Dans le code suivant, j'aimerais corriger une SELECT CASE qu'elle contien t des tâches qui se répètent.

Ainsi, j'aimerais définir les variables suivantes, parce que j'ai essay é de trouver quel type elles appartiennent sans succès (Alors j'ai comm enté Option Explicit) :

- (Reponse) et (Canal)

'---------------------------------------------------------
'Option Explicit

Sub OuvreFich()
Dim B$(), BB$(), Arr()
'Dim Reponse As Boolean, Canal As String
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


' voici la simplification que je te propose

Select Case Arr(X)
Case "12", "15"
Call maproc("PA",22)
Case "70"
Call maproc("JCW",22)
Case "33", "62"
Call maproc("MSK",22)
End Select

' fin de simplification
End If
Line Input #Canal, A$
X = X + 1
Loop
End If
End If
Loop
On Error GoTo 0
End Sub
'------------------------------------------


Sub maproc(f as String, ligne as String)
' je te laisse faire ce code
End Sub
MichD
Le #24536261
Si le Select Case est complet, je te suggère de le laisser tel que tu l'as
écrit.

Le code est parfaitement accessible et lisible et il n'y a pas grand-chose à
gagner
en voulant se triturer les esprits.
Certes à chaque Case, il y a ouverture de fichiers, mais la ligne suivante
est
différente pour chacun des cas.
Même si tu t'arrivais à écrire la même chose en 2 lignes de code de moins,
tu n'y gagnerais pas grand-chose en efficacité.
Apitos
Le #24536741
Bonsoir h2so4, Denis

Même si tu t'arrivais à écrire la même chose en 2 lignes de code de moins,
tu n'y gagnerais pas grand-chose en efficacité.



Ca n'empêche pas de faire une nouvelle tentative ;)

Qu'en dites-vous de ce code, il est optimisé ?


'---------------------------------------------------------
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
MichD
Le #24537931
| Qu'en dites-vous de ce code, il est optimisé ?

Je ne connais pas la donne du problème, mais ton code semble très bien.

Il y a plusieurs façons de résoudre une problématique et par conséquent
il n'y a pas qu'une bonne réponse. Il n'y a rien comme la pratique pour
développer ses talents et la connaissance des outils disponibles.
Souvent l'encodage dépend de quel côté de la lorgnette on regarde un
problème...le reste ce n'est qu'une question de style.

Désolé, je ne fais pas ce que tu demandes à moins que tu aies une
question très précise à demander.
Publicité
Poster une réponse
Anonyme