problème avec if ou else ou ifnot?

Version imprimable

Bonjour au forum,

J'ai un souci avec la partie de code ci-dessous. Avec l'instruction "If" j'ai par moment arrêt de macro si la condition recherchée est une autre variable (string)

Code:

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
For lA = 24 To np - 1
    'Valeur des différents cas à chercher
 
        cas1 = "Blanc"
        cas2 = "xxxx0"
        cas3 = "lnoir"
 
  '-----------------Chercher la valeur dans la feuille shD, en colonne A
 
        Set Rcas1 = shD.Columns(1).Find(What:=cas1, LookAt:=xlPart)
        Set Rcas2 = shD.Columns(1).Find(What:=cas2, LookAt:=xlPart)
        Set Rcas3 = shD.Columns(1).Find(What:=cas3, LookAt:=xlPart)
 
    '---------------Action à effectuer selon valeur
 
            If Cells(lA, 1).Value = Rcas1 Then
       Range("U21:AG21").Copy Cells(lA, 1)
       End If
           If Cells(lA, 1).Value = Rcas2 Then
       Range("U24:AG24").Copy Cells(lA, 1)
       End If
            If Cells(lA, 1).Value = Rcas3 Then
       Range("U20:AG20").Copy Cells(lA, 1)
       End If
 
 Next lA

. Je crois que si Rcas1,2,3 est une autre "string que celle des cas1,2,3 alors la macro s'arrête je voudrais qu'elle passe tout simplement à une autre ligne . J'ai essayé Else Next lA mais ça ne fait rien je ne sais pas trop si je dois rajouter un IfNot ou quelque chose dans le genre.

Merci pour vos soutiens.

08/02/2012, 10h28
Jean-Philippe André
Hello,

je recommande l'utilisation dans ton cas d'un
Code:

1 2 3 Select Case Cells(lA, 1).Value: '... End Select
Qyuant à l'arrêt de la macro, tu entends par là une erreur est générée ? Laquelle ?
08/02/2012, 10h56
tompom3108

Bonjour,
merci pour cette réponse.

L'erreur que j'obtiens est :<< Erreur d'execcution '91' : Variable objet ou variable bloc with non définie>> et quand je pointe la souris sur Rcas1 = "nothing" ce qui est normal puisque la colonne A qui est "scannée" n'a pas toujours les valeurs des variables cas1,2,3. Ce que je ne comprends pas bien c'est que parfois sur certaines feuilles "scannées" ça marche, bien que les valeurs de la colonne A soit alors des nombres et non des strings.
En fait cette erreur survient uniquement quand la feuille comprend des strings
différentes (colonne A) de cas1, cas2, cas3. Et j'ai essayé select case mais j'ai eu le même souci y compris avec les nombres du coup j'ai essayé avec if et j'ai cru que ça fonctionnait ... mais pas longtemps.
Pour select case comment écrire si le cas est autre que cas1,2,3 et sortir
de l'instruction pour aller sur la prochaine ligne?
08/02/2012, 11h00
Jean-Philippe André

En fait, à partir du moment où tu manipules les données à partir du niveau Worsksheet (ce qui semble etre le cas avec ton shD), il est necessaire de l'utiliser "partout" dans ton code.

Aussi ton Cells() n'est relié à aucune feuille spécifique.

Il te faut donc le spécifier, par exemple si tu manipules toujours ta feuille shD, ca donnerait :

Code:

shd.Cells(lA, 1).Value

J'ai rajouté les nom des feuilles

Code:

1
2
3
4
5
6
7
8
9
 If shD.Cells(lA, 1).Value = Rcas1 Then
       Range("U21:AG21").Copy Cells(lA, 1)
       End If
           If shD.Cells(lA, 1).Value = Rcas2 Then
       Range("U24:AG24").Copy Cells(lA, 1)
       End If
            If shD.Cells(lA, 1).Value = Rcas3 Then
       Range("U20:AG20").Copy Cells(lA, 1)
       End If

Même réponse.

ne faudrait-il pas que j'ajoute une condition du genre si different de cas1,
cas2, cas3 alors next ligne?

08/02/2012, 11h29
Jean-Philippe André

Tes Rcas1 et co, quel est leur type lors de la déclaration ?

Sinon, meme chose que pour les Cells, tu dois appliquer le shD à tes Range ;)

Je te remercie de ta patience ;)

Pour Rca1&co et cas&co,

Code:

1
2
Dim Rcas1 As Range, Rcas2 As Range, Rcas3 As Range, Rcas4 As Range
Dim cas1 As String, cas2 As String, cas3 As String, cas4 As String

ensuite j'ai rajouté les shD partout :

Code:

1
2
3
4
5
6
7
8
9
       If shD.Cells(lA, 1).Value = Rcas1 Then
       shD.Range("U21:AG21").Copy Cells(lA, 1)
       End If
           If shD.Cells(lA, 1).Value = Rcas2 Then
       shD.Range("U24:AG24").Copy Cells(lA, 1)
       End If
            If shD.Cells(lA, 1).Value = Rcas3 Then
       shD.Range("U20:AG20").Copy Cells(lA, 1)
       End If

même combat. même erreur.
je mets le code complet au cas ou même s'il est un peu long

Code:

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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
Sub Modifmercatog()
 
Dim wbS As Workbook, wbModif As Workbook
Dim shS As Worksheet, shM As Worksheet, shD As Worksheet
Dim RModVal As String, N_Client As String, FichModif As String
Dim RMod As Range, Rdp1 As String, Plag As Range, Rnp As Range
Dim np As Integer, x As Integer, compt As Integer, lA As Integer
Dim Rcas1 As Range, Rcas2 As Range, Rcas3 As Range, Rcas4 As Range
Dim cas1 As String, cas2 As String, cas3 As String, cas4 As String
Dim lht As Integer, lAp As Integer
Dim Rht As Range, Plage As Range
Dim ht As Single
 
Set wbS = Workbooks.Open("Z:\Gestion entreprise\VBA\Atest\CC2011T.xlsx")
Set shS = wbS.Worksheets("Pilote1")
shS.Activate
 
On Error Resume Next
Set RMod = Application.InputBox("Sélectionnez une plage !", "Sélection de cellules", Type:=8)
On Error GoTo 0
 
If Not RMod Is Nothing Then
    RMod.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    RModVal = RMod(1, 1).Value
    N_Client = shS.Cells(RMod.Row, 8).Value
    FichModif = RModVal & " " & N_Client & ".xls"
 
    'Ici fonction qui permet de vérifier si FichModif est ouvert dans la même instance Excel
 
    If Existe(FichModif) Then
        Set wbModif = Workbooks(FichModif)
        Set shM = wbModif.Worksheets("Devis")
        Set shD = ThisWorkbook.Worksheets("Devis")
 
       '---------------------------compter le nombre de ligne entre A24 et A(Pied de page)
       shD.Unprotect
       Set Plag = shM.Range("A24:A500")
 
 For Each Rnp In Plag
    If Rnp.Value = "Pieddepage" Then
    np = Rnp.Row
    x = np - 23
  End If
Next
       '----------------------------insérer les lignes dans shD
       If x > 33 Then
       For compt = 1 To x - 33
 
       shD.Activate
        shD.Range(Cells(24, 1), Cells(24, 14)).Select
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
       Range("U22:AH22").Copy shD.Cells(24, 1)
 
    Next
    End If
 
    '-----------Copier entre la ligne 23 et la ligne np les cellules colonne A de shM dans shD
    shM.Activate
    shM.Range(Cells(24, 1), Cells(np - 1, 1)).Copy shD.Range("A24")
 
 
    '---------- Appeler les macros en fonctions des valeurs colonne A de shD
    shD.Activate
    ' balayage de la colonne A de shD
For lA = 24 To np - 1
    'Valeur des différents cas à chercher
 
        cas1 = "Blanc"
        cas2 = "xxxx0"
        cas3 = "lnoir"
 
  '-----------------Chercher la valeur dans la feuille shD, en colonne A
 
        Set Rcas1 = shD.Columns(1).Find(What:=cas1, LookAt:=xlPart)
        Set Rcas2 = shD.Columns(1).Find(What:=cas2, LookAt:=xlPart)
        Set Rcas3 = shD.Columns(1).Find(What:=cas3, LookAt:=xlPart)
 
    '---------------Action à effectuer selon valeur
 
               If shD.Cells(lA, 1).Value = Rcas1 Then
       shD.Range("U21:AG21").Copy Cells(lA, 1)
       End If
           If shD.Cells(lA, 1).Value = Rcas2 Then
       shD.Range("U24:AG24").Copy Cells(lA, 1)
       End If
            If shD.Cells(lA, 1).Value = Rcas3 Then
       shD.Range("U20:AG20").Copy Cells(lA, 1)
       End If
 
 
 Next lA
'-----------Copier de la ligne 24 et la ligne np-1  la plage de cellules colonne H (détails)
 
shM.Activate
shM.Range(Cells(24, 8), Cells(np - 1, 8)).Copy shD.Cells(24, 8)
 
'-----------Copier entre la ligne 24 et la ligne (np-1) la plage de cellules colonne C à G
 
shM.Range(Cells(24, 3), Cells(np - 1, 7)).Copy shD.Cells(24, 3)
 
shD.Activate
'-----------valeur du cas à rechercher pour remise professionnelle
For lAp = 24 To np
 
cas4 = "Remise professionnelle"
 
'-----------chercher si remise professionnelle
 
Set Rcas4 = shD.Columns(8).Find(What:=cas4, LookAt:=xlPart)
 
If shD.Cells(lAp, 8).Value = Rcas4 Then
        shM.Activate
        shM.Cells(lAp, 13).Copy shD.Cells(lAp, 13)
End If
 
Next lAp
'---------------------copier le nom de chantier et la taxe ctmnc
shM.Activate
shM.Range("H21").Copy shD.Range("H21")
shM.Range("O19").Copy shD.Range("O19")
 
'---------------------voir pour les sauvegardes
 
shD.Activate
shD.Protect
 
        Set wbModif = Nothing
        Set shM = Nothing
        Set shD = Nothing
    End If
End If
 
 
Set RMod = Nothing
Set shS = Nothing
wbS.Close False
Set wbS = Nothing
 
End Sub

08/02/2012, 11h52
Jean-Philippe André

Je viens de faire le recoupement entre les différents postes :ccool:

En fait, tu dois faire un test que la fonction Find te retourne bieune valeur dans RCas1.

si Rcas1 ne vaut pas Nothing alors... devient

Code:

If Not (Rcas1 Is Nothing) Then

bon je sais pas si j'ai bien fait mais ça a l'air de marcher, j'ai écrit comme ça :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 If Not (Rcas1 Is Nothing) Then
       If shD.Cells(lA, 1).Value = Rcas1 Then
       shD.Range("U21:AG21").Copy Cells(lA, 1)
       End If
       End If
 
       If Not (Rcas2 Is Nothing) Then
        If shD.Cells(lA, 1).Value = Rcas2 Then
       shD.Range("U24:AG24").Copy Cells(lA, 1)
       End If
       End If
 
        If Not (Rcas3 Is Nothing) Then
        If shD.Cells(lA, 1).Value = Rcas3 Then
        shM.Activate
       shM.Range(Cells(lA, 1), Cells(lA, 13)).Copy shD.Cells(lA, 1)
       End If
      End If
 
 Next lA

En tout cas merci et à bientôt peut être.