Cellule qui change = action

Version imprimable

Bonjour voici mon petit programme vba qui ne marche pas.
Code:

1 2 3 4 5 6 7 Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Range("b4:b1000"), Target) Is Nothing Then If Right(Range.Select, 4) = "CAMP" Then Selection.Interior.ColorIndex = 46 End If End If End Sub
En clair quand ma cellule change de valeur dans la colonne b, si les 4 premiere lettre de la chaine s'appelle CAMP je met en orange ma case.

En deuxieme temps il ira me chercher des données que je vais ecrire dans les cellule.
(ca je sais faire)
si je met "camp" dans ma cellule B3, il m'affichera en B4 la donnee 1 recuperer, en B5 la donnee 2 etc... Pour ca il faut que je relève le numero de la ligne changé.

Sa marche pas...

De l'aide, help me

Salut,

Citation:

si les 4 premieres lettres de la chaine s'appelle CAMP

La fonction Right retourne les derniers caractères, pas les premiers.

Essaye avec :
Code:

1 2 3 4 5 6 7 Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Range("b4:b1000"), Target) Is Nothing Then If Left(Target, 4) = "CAMP" Then Target.Interior.ColorIndex = 46 End If End If End Sub

22/07/2013, 10h50
EngueEngue

Je pense que tu as un problème de repérage de droite et gauche.

Alors un conseil:
Si tu es gaucher tu fais semblant d'écrire et cette main c'est ta main gauche! A l'inverse pour la droite.

Fais attention lorsque tu conduis la priorité est à droite!

Tes quatre premières lettres sont CAMP so:

Code:

left(target,4)

(On écrit de gauche à droite en français!)
22/07/2013, 11h08
guismoman60

Désolé pour cette erreur, concentrons nous plus sur le faites...

J'ai bien avancer sur le programme, mais comment avoir le numéro de la ligne qui a changé?
22/07/2013, 11h12
BlueMonkey

Dans Sub Worksheet_Change(ByVal Target As Range) tu peux utiliser Target.Row pour récupérer le n° de la ligne qui a changé.

Merci beaucoup de votre aide. Mon petit script avance mais bloque :cry:

Voici mon code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i, j, c As Integer
Target.Row = i
c = 1
 
 If Not Intersect(Range("b4:b1000"), Target) Is Nothing Then
 
        If Left(Sheets("PLANNING").Cells(i, 2), 4) = "CAMP" Then
            Sheets("PLANNING").Cells(i, 2).Interior.ColorIndex = 46
            For j = 4 To 1000
                If Sheets("CODE").Cells(j, 3) = Sheets("PLANNING").Cells(i, 4) And Sheets("CODE").Cells(j, 4) = Sheets("PLANNING").Cells(i, 5) And Sheets("CODE").Cells(j, 5) = Sheets("PLANNING").Cells(i, 6) And Left(Sheets("CODE").Cells(j, 7), 2) = Sheets("PLANNING").Cells(i, 7) And Sheets("CODE").Cells(j, 8) = Sheets("PLANNING").Cells(i, 8) Then
 
                    Sheets("PLANNING").Cells(i + c, 2) = Sheets("CODE").Cells(j, 1)
                    c = c + 1
                End If
            Next
         End If
 
 End If
 End Sub

Merci de votre aide

22/07/2013, 11h26
EngueEngue

Je ne vois pas oùu est le problème.. Et si tu nous expliquais ce qui beugue ?

Change:

Code:

Dim i, j, c As Integer

Par:

Code:

Dim i as integer, j as integer, c as integer
22/07/2013, 11h31
guismoman60

Nombre d'arguments incorrect ou affectation de propriété incorrect, le probleme viens du target.rows...
22/07/2013, 11h32
BlueMonkey
Qu'est ce que tu espère avoir avec Target.Row = i ?
Sans l'initialisé i vaut 0. Et le premier indice de ligne accessible est 1. :aie:
Code:

1 2 3 Private Sub Worksheet_Change(ByVal Target As Range) Dim i, j, c As Integer Target.Row = i
Dans Sub Worksheet_Change(ByVal Target As Range) si tu change la valeur d'une cellule,
tu provoque un nouvel évènement Worksheet_Change(), ce qui peut provoquer une boucle infinie.

Pour s'en prémunir, tu peux utiliser Application.EnableEvents = false en début de routine et Application.EnableEvents = True à la fin.

Sinon il faudrait nous dire où ça bloque ? Qu'est ce qui se passe (message d'erreur, boucle infinie ?)
22/07/2013, 11h36
EngueEngue

Si je comprends bien tu confonds encore gauche et droite...

Mets plutôt:

Code:

i = Target.Row

Sans regarder en profondeur, adaptes déjà ce code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer, j As Integer, c As Integer
c = 1
With Sheets("PLANNING")
If Not Intersect(Range("b4:b1000"), Target) Is Nothing Then
  i = Target.Row
  If Left(.Cells(i, 2), 4) = "CAMP" Then
    .Cells(i, 2).Interior.ColorIndex = 46
    For j = 4 To 1000
      If Sheets("CODE").Cells(j, 3) = .Cells(i, 4) And Sheets("CODE").Cells(j, 4) = .Cells(i, 5) And Sheets("CODE").Cells(j, 5) = S.Cells(i, 6) _
        And Left(Sheets("CODE").Cells(j, 7), 2) = .Cells(i, 7) And Sheets("CODE").Cells(j, 8) = .Cells(i, 8) Then
        .Cells(i + c, 2) = Sheets("CODE").Cells(j, 1)
        c = c + 1
      End If
    Next j
  End If
End If
End With
End Sub

Merci beaucoup ca marche.

Une autre question. Voici le code éclatage qui marche.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub eclatage()
Dim j As Integer
Dim i As Integer
 
i = ActiveCell.Row
 
            For j = 37 To 500
                If Sheets("CODE").Cells(j, 3) = Sheets("PLANNING").Cells(i, 4) And Sheets("CODE").Cells(j, 4) = Sheets("PLANNING").Cells(i, 5) And Sheets("CODE").Cells(j, 5) = Sheets("PLANNING").Cells(i, 6) And Left(Sheets("CODE").Cells(j, 7), 2) = Sheets("PLANNING").Cells(i, 7) And Sheets("CODE").Cells(j, 8) = Sheets("PLANNING").Cells(i, 8) Then
 
                    Sheets("PLANNING").Cells(i + c, 2) = Sheets("CODE").Cells(j, 1)
                    Sheets("PLANNING").Cells(i + c, 2).Interior.ColorIndex = 37
                    c = c + 1
                End If
            Next
End Sub

Donc il m'affiche mes produits les un derrière les autre et ca me plait. Mais le top du top serait que ca insert une ligne (en gardant les calculs) et que ca m'affiche le produit dedant... Autant d'insertion que de produit... En clair :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub eclatage()
Dim j As Integer
Dim i As Integer
 
i = ActiveCell.Row
 
            For j = 37 To 500
                If Sheets("CODE").Cells(j, 3) = Sheets("PLANNING").Cells(i, 4) And Sheets("CODE").Cells(j, 4) = Sheets("PLANNING").Cells(i, 5) And Sheets("CODE").Cells(j, 5) = Sheets("PLANNING").Cells(i, 6) And Left(Sheets("CODE").Cells(j, 7), 2) = Sheets("PLANNING").Cells(i, 7) And Sheets("CODE").Cells(j, 8) = Sheets("PLANNING").Cells(i, 8) Then
                    "JE COPIE UNE LIGNE AVEC LES CALCUL ET JE MET LES INSTRUCTION QUI SUIVENT DANS MA LIGNE CREER"
                    Sheets("PLANNING").Cells(i + c, 2) = Sheets("CODE").Cells(j, 1)
                    Sheets("PLANNING").Cells(i + c, 2).Interior.ColorIndex = 37
                    c = c + 1
                End If
            Next
End Sub

Et la je bloque, je ne sais pas comment faire, c'est le flou total

22/07/2013, 15h49
EngueEngue

Et maman elle avait acheté un avion qui disait oui et je suis allé voir spiderman et il faisait très beau pendant qu'il mangeait plein de glaces et des arc en ciel :ccool:
22/07/2013, 16h16
guismoman60

Mec je ne suis pas le genre de mec que tu crois. Je programme beaucoup en web : php mysql, et je viens de me mettre au macro. En clair la je demande juste comment copier une ligne en gardant les calculs. Si tu ne veux pas m'aider, répond pas ;) Je ne suis pas débutant dans la programmation, je suis debutant en VBA... Si tu dis ca à des petits jeunes, ils sont pas près de programmer lol...

Merci quand meme pour ton aide précédente...
22/07/2013, 16h20
EngueEngue

Je rigolais parce que tu t'exprimes très mal.. C'est indéchiffrable.

Si j'ai bien compris :

Code:

.PasteSpecial Paste:=xlPasteFormulas
22/07/2013, 16h28
guismoman60

C'est vrai que je m'exprime mal, et cela à toujours été mon défault. Quand tu es à fond dans ton programme avec une application précise, c'est dure de comprendre loool je vais essayer ce que tu m'as dit, je reviens vers toi...

Merci encore
24/07/2013, 12h00
guismoman60

Merci beaucoup pour toutes ses informations. RESOLU