Macro inputbox modifier valeur sur autre feuille

Version imprimable

Bonjour !

J'ai une macro qui marchait avant mais qui aujourd'hui ne marche plus, étant donné que j'ai changé la structure de mon fichier.
J'essaye de vous expliquer en quelques lignes ce que je cherche à faire, ~~mais je crois que l'exemple que je vous joint sur le fichier test sera bien plus parlant.~~

Dans la feuille macros l'utilisateur vient clicker sur le bouton "Modifier date".
Cela lui lance un 1er inputbox lui demandant de saisir un nombre de 1 à 20
Puis un 2ème inputbox lui demandant de saisir une date.

Si il saisit 1 et 01/12/2011 je veux que la date saisie vienne s'inscrire dans la feuille "database" à un endroit précis.
Cette endroit dépend du numéro inscrit en A2 de la feuille macros.
Dans mon exemple si le numéro est 1 alors la macro est censée venir trouver dans la colonne 1 de la feuille database la ligne correspond à ce numéro 1. La colonne qui correspond est quand à elle IV si il avait saisit 1 lors d1 er inputbox, IX si il avait saisit 2, et ainsi de suite (de 2 en 2).

J'espère avoir été clair..

Voici mon code :

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
Sub Bouton4_Clic()
Dim liste As Variant, l As Long
'MACRO Modif Date
 
liste = Array(1, 3, 4, 6, 7, 8, 10, 12, 13, 15, 21, 22, 23, 25, 33, 35, 36, 37, 39, 40, 41, 42, 43, 50, 51, 52, 54, 55, 56)
 
rev = InputBox("Enter 1 for REV1, 2 for REV2, etc.", "REV Date Modification")
 
If rev = "" Or Not IsNumeric(rev) Then
MsgBox "Canceled, Please Enter a number"
Exit Sub
 
End If
 
If rev < 1 Or rev > 20 Then
 
MsgBox "wrong rev number"
Exit Sub
End If
 
rev = CInt(rev)
 
mdir = InputBox("SELECT THE DATE: (dd/mm/yy)", "REV x")
If Not IsDate(mdir) Then
MsgBox "Canceled"
Exit Sub
End If
For l = LBound(liste) To UBound(liste)
Select Case rev
 
Case 1
If Range("A2") = liste(l) Then Sheets("database").Range("IV" & 1 + 3).Value = CDate(mdir)
 
Case 2
If Range("A2") = liste(l) Then Sheets("database").Range("IX" & l + 2).Value = CDate(mdir)
 
Case 3
If Range("A2") = liste(l) Then Sheets("database").Range("IZ" & l + 2).Value = CDate(mdir)
 
Case 4
If Range("A2") = liste(l) Then Sheets("database").Range("JB" & l + 2).Value = CDate(mdir)
 
Case 5
If Range("A2") = liste(l) Then Sheets("database").Range("JD" & l + 2).Value = CDate(mdir)
 
Case 6
If Range("A2") = liste(l) Then Sheets("database").Range("JF" & l + 2).Value = CDate(mdir)
 
Case 7
If Range("A2") = liste(l) Then Sheets("database").Range("JH" & l + 2).Value = CDate(mdir)
 
Case 8
If Range("A2") = liste(l) Then Sheets("database").Range("JJ" & l + 2).Value = CDate(mdir)
 
Case 9
If Range("A2") = liste(l) Then Sheets("database").Range("JL" & l + 2).Value = CDate(mdir)
 
Case 10
If Range("A2") = liste(l) Then Sheets("database").Range("JN" & l + 2).Value = CDate(mdir)
 
Case 11
If Range("A2") = liste(l) Then Sheets("database").Range("JP" & l + 2).Value = CDate(mdir)
 
Case 12
If Range("A2") = liste(l) Then Sheets("database").Range("JR" & l + 2).Value = CDate(mdir)
 
Case 13
If Range("A2") = liste(l) Then Sheets("database").Range("JT" & l + 2).Value = CDate(mdir)
 
Case 14
If Range("A2") = liste(l) Then Sheets("database").Range("JV" & l + 2).Value = CDate(mdir)
 
Case 15
If Range("A2") = liste(l) Then Sheets("database").Range("JX" & l + 2).Value = CDate(mdir)
 
Case 16
If Range("A2") = liste(l) Then Sheets("database").Range("JZ" & l + 2).Value = CDate(mdir)
 
Case 17
If Range("A2") = liste(l) Then Sheets("database").Range("KB" & l + 2).Value = CDate(mdir)
 
Case 18
 
If Range("A2") = liste(l) Then Sheets("database").Range("KD" & l + 2).Value = CDate(mdir)
 
Case 19
If Range("A2") = liste(l) Then Sheets("database").Range("KH" & l + 2).Value = CDate(mdir)
 
 
 
End Select
Next

Merci énormément par avance!!

Adrien

14/11/2011, 11h12
francky74

macro

Bonjour,
A quel endroit obtiens tu une erreur (quelle ligne ?) ?

Aprés le

Code:

Case 19

il te faut rajouter une ligne

Code:

case else

C'est plus prudent !
14/11/2011, 11h22
laduche31

Bonjour et merci pour votre réponse. Oui en effet c'est plus prudent.

Mon code fonctionnait car j'avais un tableau qui était fixe et répétitif.
C'est à dire que la structure était toujours la même.

Or maintenant je suis amené à insérer des lignes, la liste des nombres bouge, etc.

Du coup mon code n'est plus adapté, il ne me faut plus utiliser de liste, je pense. Et je ne sais pas comment faire autrement :s
14/11/2011, 11h26
francky74

liste

Justement, au sujet de cette liste, tu te sert seulement de liste(1).
a quoi te sert cette liste ?
14/11/2011, 11h45
laduche31

dans ma première colonne j'ai une liste de numéros :
1,3,4 etc. qui n'ont aucune relation les uns avec les autres.
Mon but est, dans une feuille à part de :
1) donner certaines informations via des recherchev d'après les numéros de ma liste (pas de macro ici),
2) donner la possibilité à l'utilisateur de modifier via cette feuille des informations contenues dans la feuille où se trouve mon tableau. Cette modification est liée au numéro de ma liste et va se placer dans un endroit bien précis IV dans le cas 1, IX dans le cas 2 , etc.

Bonjour,

Citation:

Dans mon exemple si le numéro est 1 alors la macro est censée venir trouver dans la colonne 1 de la feuille database la ligne correspond à ce numéro 1. La colonne qui correspond est quand à elle IV si il avait saisit 1 lors du 1er inputbox.

Le fonctionnement de ta macro est différent de ce que tu indiques.

Code:

1
2
3
Select Case rev 
Case 1
If Range("A2") = liste(l) Then Sheets("database").Range("IV" & l + 2).Value = CDate(mdir)

Si le numéro (rev) est 1 alors la colonne à sélectionner dans la feuille "database" est la colonne IV.
La macro va chercher dans la liste le numéro correspondant à la valeur de la cellule A2 (3 par exemple) et va inscrire la date dans la colonne IV, à la ligne correspondant à la position (l=1) du numéro dans la liste, position à laquelle on ajoute 2.
Dans la liste, le numéro 3 occupe la position 1.
La date est donc inscrite en IV3.

Autre exemple :
Si le numéro (rev) est 6 la colonne est JF.
Si la valeur de la cellule A2 est 7, la position occupée par le chiffre 7 dans liste est l=4.
La date est donc inscrite en JF6.

Reste à voir si c'est bien ce fonctionnement qui t'intéresse.

Cordialement.

Voici le code qui te permet de remplacer ta liste par la plage A2 :Ax de la feuille "database" (x étant la dernière ligne renseignée de la colonne).

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
Option Base 1
Option Explicit
Private Sub Bouton4_Click()
Dim liste(), DerLig As Long, l As Long, rev As Variant, mdir As Variant
With Worksheets("database")
    DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
    liste = .Range("A2:A" & DerLig).Value
End With
rev = InputBox("Enter 1 for REV1, 2 for REV2, etc.", "REV Date Modification")
If rev = "" Or Not IsNumeric(rev) Then
    MsgBox "Canceled, Please Enter a number"
    Exit Sub
End If
If rev < 1 Or rev > 20 Then
    MsgBox "wrong rev number"
    Exit Sub
End If
rev = CInt(rev)
mdir = InputBox("SELECT THE DATE: (dd/mm/yy)", "REV x")
If Not IsDate(mdir) Then
    MsgBox "Canceled"
    Exit Sub
End If
For l = LBound(liste) To UBound(liste)
    Select Case rev
    Case 1
        If Range("A2") = liste(l, 1) Then Sheets("database").Range("IV" & l + 1).Value = CDate(mdir)
    Case 2
        If Range("A2") = liste(l, 1) Then Sheets("database").Range("IX" & l + 1).Value = CDate(mdir)
    Case 3
        If Range("A2") = liste(l, 1) Then Sheets("database").Range("IZ" & l + 1).Value = CDate(mdir)
    Case 4
        If Range("A2") = liste(l, 1) Then Sheets("database").Range("JB" & l + 1).Value = CDate(mdir)
    Case 5
        If Range("A2") = liste(l, 1) Then Sheets("database").Range("JD" & l + 1).Value = CDate(mdir)
    Case 6
        If Range("A2") = liste(l, 1) Then Sheets("database").Range("JF" & l + 1).Value = CDate(mdir)
    Case 7
        If Range("A2") = liste(l, 1) Then Sheets("database").Range("JH" & l + 1).Value = CDate(mdir)
    Case 8
        If Range("A2") = liste(l, 1) Then Sheets("database").Range("JJ" & l + 1).Value = CDate(mdir)
    Case 9
        If Range("A2") = liste(l, 1) Then Sheets("database").Range("JL" & l + 1).Value = CDate(mdir)
    Case 10
        If Range("A2") = liste(l, 1) Then Sheets("database").Range("JN" & l + 1).Value = CDate(mdir)
    Case 11
        If Range("A2") = liste(l, 1) Then Sheets("database").Range("JP" & l + 1).Value = CDate(mdir)
    Case 12
        If Range("A2") = liste(l, 1) Then Sheets("database").Range("JR" & l + 1).Value = CDate(mdir)
    Case 13
        If Range("A2") = liste(l, 1) Then Sheets("database").Range("JT" & l + 1).Value = CDate(mdir)
    Case 14
        If Range("A2") = liste(l, 1) Then Sheets("database").Range("JV" & l + 1).Value = CDate(mdir)
    Case 15
        If Range("A2") = liste(l, 1) Then Sheets("database").Range("JX" & l + 1).Value = CDate(mdir)
    Case 16
        If Range("A2") = liste(l, 1) Then Sheets("database").Range("JZ" & l + 1).Value = CDate(mdir)
    Case 17
        If Range("A2") = liste(l, 1) Then Sheets("database").Range("KB" & l + 1).Value = CDate(mdir)
    Case 18
        If Range("A2") = liste(l, 1) Then Sheets("database").Range("KD" & l + 1).Value = CDate(mdir)
    Case 19
        If Range("A2") = liste(l, 1) Then Sheets("database").Range("KH" & l + 1).Value = CDate(mdir)
End Select
Next
End Sub

Cordialement.

14/11/2011, 13h46
laduche31

Bonjour gFZT82,

Tout d'abord merci pour tes réponses!

Pour ton premier message tu as tout à fait compris ce que je voulais faire.
Cependant ce code est le reflet de ce que je voulais faire avant, à présent j'ai besoin de plus de flexibilité, ce que la liste ne permet pas.

Je n'ai pas encore bien compris ton deuxième message mais je vais essayer de comprendre par l'essai, je teste ton code.

Merci beaucoup !

Cordialement,

Adrien.
14/11/2011, 14h05
laduche31

C'est parfait c'est exactement ce que je voulais faire,
merci pour ton aide, tu me sors une belle épine du pied! :ccool:

Je te souhaite une bonne journée et une nouvelle fois merci!
Merci également à francky.

Cordialement,

Adrien.