[XL-2007] transfert de donnees [Résolu]

[chris09300]

bonjour
je dois remplir des cellules dans les colonnes Z, AA, et AB
de la ligne 3 a 67
quand je rentre une heure ex: 9h00 en Z3 je voudrais verifier dans la ligne A2 R2 si je trouve la valeur rentree, si oui copier la valeur de la cellule X3 sans la couleur dans la cellule trouve en ligne A. Si il a deja une valeur dans cette cellule voir la cellule adjacente.
je vous joint un fichier pour une meilleure vision.
merci
cris

[mercatog]

Bonjour

je voudrais verifier dans la ligne A2 R2 si je trouve la valeur rentree, si oui copier la valeur de la cellule X3 sans la couleur dans la cellule trouve en ligne A

Avant de joindre ton fichier, relis ce passage si tu comprends quelque chose

Tu cherche la valeur entrée en Z3 et tu la recherche dans A2:R2
Puis tu dis qu'il faut écrire X3 dans la cellule adjascente à la cellule trouvé en ligne A.

Ligne A? je ne comprends pas de quoi il s'agit.
La recherche est en A2:R2, c'est à dire en ligne 2 de la colonne A à la colonne R.

A toi de préciser.

[chris09300]

bonjour mercatog

Ligne A? je ne comprends pas de quoi il s'agit.
La recherche est en A2:R2, c'est à dire en ligne 2 de la colonne A à la colonne R.

oui c'est exact c'est bien la ligne 2 Colonne A a R
et quand je parle de colonne adjacente,c'est la cellule en dessous.

c'est pour cela que j'ai joint un fichier, car moi je vois bien ce que je souhaiterais faire mais pas toujours facile d'etre tres clair.
excuse moi
cris

[mercatog]

J'ai 2 question supplémentaires:
Tes données en A2 à R2 et celles de la colonne Z sont du texte ou des heures?
Est ce que tu as des données en dessous des colonnes de A à R?

[chris09300]

les donnees sont des heures.
je n'est pas de donnees sous les colonnes A a R

[mercatog]

Je n'ai pas besoin de ton fichier.
Mets ce code dans le module de ta feuille (évènement Change)

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Byte
 
If Target.Column = 26 And Target.Count = 1 Then
    If Target.Value <> "" Then
        For i = 1 To 18
            If Abs(Cells(2, i) - Val(Target.Value)) < 0.001 Then
                Application.EnableEvents = False
                Cells(ActiveSheet.Rows.Count, i).End(xlUp)(2) = Range("X" & Target.Row).Value
                Application.EnableEvents = True
                Exit For
            End If
        Next i
    End If
End If
End Sub

Edit: change ligne 7

[chris09300]

il bogue a la ligne 7.
je ne vois pas ce qu'il faut que je change en ligne 7
je rentre 9H00 ou 9h00 par ex:
et sur mon fichier j'aurais la meme chose a faire avec des lignes differentes
cris

[mercatog]

Parce que tu avais répondu que tes données sont des heures.
C'est à dire des nombres formatés 09h00
Alors que si tu écris en dur 9h00 ça revient à un texte. d'où le problème et d'où l'exactitude des informations données.

Essaies ceci

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Byte
 
If Target.Column = 26 And Target.Count = 1 Then
    If Target.Value <> "" Then
        For i = 1 To 18
            If Target.Value = Cells(2, i) Then
                Application.EnableEvents = False
                Cells(ActiveSheet.Rows.Count, i).End(xlUp)(2) = Range("X" & Target.Row).Value
                Application.EnableEvents = True
                Exit For
            End If
        Next i
    End If
End If
End Sub

Ou bien celui là en utilisant la méthode Find (éviter la boucle)

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
 
If Target.Column = 26 And Target.Count = 1 Then
    If Target.Value <> "" Then
            Set c = Range("A2:R2").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
                Application.EnableEvents = False
                Cells(ActiveSheet.Rows.Count, c.Column).End(xlUp)(2) = Range("X" & Target.Row).Value
                Application.EnableEvents = True
                Set c = Nothing
            End If
    End If
End If
End Sub

[chris09300]

j'ai entre 9h30 en Z3 et rien se passe
le code je l'est mis dans la feuille D-Base

[mercatog]

Tu as des données en dessous de la ligne 2?

[chris09300]

je n'est rien en ligne 3 et ligne 4

cris

j'ai des valeurs en A2 a R2
A5 a R5
A8 a R8
A11 a R11
et A14 a M14
cris

[mercatog]

Donc tu as des données en dessous de la ligne 2. or dans l'une de tes réponses, tu affirmais le contraire.
En dessous ou juste les 2 lignes en dessous, ça diffère.
Je me demande aussi si les codes qu'on te propose sont analysés ou bien simplement copiés.

A ma connaissance, supposons que en A2 tu as 9H00, A3 vide, A4 vide et A5 remplie par autre chose

Supposons qu'en X3 tu as "toto", en X7: "Tata" et en X21 "Kuku"

Si on mets 9H00 en Z3, on aura en A3: "Toto"
Ensuite on mets 9H00 en Z7, on aura en A4: Tata" (car A3 est déjà remplie)
Si ensuite on va mettre 9H00 en Z21, le "kuku" sera où? (A5 est déjà remplie)
Des explications claires et précises seront les bienvenues sans une multitudes de fichiers en PJ qui ne font qu'alourdir ce précieux forum.

Je ne vais pas faire la morale, mais excusez moi, vous ne voulez rien expliquer, vous ne voulez rien analyser et vous voulez qu'on t'aide efficacement.
On demande l'aide sans pour autant fournir un effort pour expliquer où on coince.

Le code fourni, fais pratiquement ce que tu souhaites selon tes explications initiales.

[chris09300]

bonsoir mercatog
je ne fait jamais de copier coller, sans avoir decortique le code reçu.

mais il y a dans le code des fonction que je ne connais pas, donc je regarde dans l'aide pour mieux comprendre.

j'ai essaye les deux codes sans resultats.

je n'est envoye qu'un seul fichier en piece jointe, pour mieux voir.

quand je mets 10h00 en Z3 je souhaiterais verifier dans la ligne 2 de A2 a R2, si on trouve cette heure, si oui copier la valeur de X3 en dessous de la valeur trouvee dans la ligne 2.

voila
cris

[mercatog]

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
 
If Target.Column = 26 And Target.Count = 1 Then
    If Target.Value <> "" Then
            Set c = Range("A2:R2").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
                Application.EnableEvents = False
                c.Offset(1, 0) = Range("X" & Target.Row).Value
                Application.EnableEvents = True
                Set c = Nothing
            End If
    End If
End If
End Sub

[chris09300]

ca fonctionne
j'ai continue le code pour mon tableau:

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Dim d As Range
Dim e As Range
Dim f As Range
Dim g As Range
 
If Target.Column = 26 And Target.Count = 1 Then
    If Target.Value <> "" Then
            Set c = Range("A2:R2").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
                Application.EnableEvents = False
                Cells(3, c.Column) = Range("X" & Target.Row).Value
                Application.EnableEvents = True
                Set c = Nothing
            End If
    End If
End If
If Target.Column = 27 And Target.Count = 1 Then
    If Target.Value <> "" Then
            Set d = Range("A5:R5").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not d Is Nothing Then
                Application.EnableEvents = False
                Cells(6, d.Column) = Range("X" & Target.Row).Value
                Application.EnableEvents = True
                Set d = Nothing
            End If
    End If
End If
If Target.Column = 27 And Target.Count = 1 Then
    If Target.Value <> "" Then
            Set e = Range("A8:R8").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not e Is Nothing Then
                Application.EnableEvents = False
                Cells(9, e.Column) = Range("X" & Target.Row).Value
                Application.EnableEvents = True
                Set e = Nothing
            End If
    End If
End If
If Target.Column = 27 And Target.Count = 1 Then
    If Target.Value <> "" Then
            Set f = Range("A11:R11").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not f Is Nothing Then
                Application.EnableEvents = False
                Cells(12, f.Column) = Range("X" & Target.Row).Value
                Application.EnableEvents = True
                Set f = Nothing
            End If
    End If
End If
If Target.Column = 28 And Target.Count = 1 Then
    If Target.Value <> "" Then
            Set g = Range("A14:R14").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not g Is Nothing Then
                Application.EnableEvents = False
                Cells(15, g.Column) = Range("X" & Target.Row).Value
                Application.EnableEvents = True
                Set g = Nothing
            End If
    End If
End If
End Sub

j'ai un petit probleme, a partir de la ligne A5 a R5
j'ai deux fois les memes heures
9h00 - 9h00 - 10h00 - 10h00
comment faire pour lui dire que si la cellule en dessous de la premiere fois ou il y a 9h00 et qu'il y a deja une valeur de voir si il ne rencontre pas encore sur la ligne 9h00 et ecrire la seconde valeur dans la cellule en dessous.

9h00 - 9h00
7101 7102
c'est le resultat final souhaite.
cris

[mercatog]

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
 
If Target.Column = 26 And Target.Count = 1 Then
    Transfert Target, Range("A2:R2")
ElseIf Target.Column = 27 And Target.Count = 1 Then
    Transfert Target, Union(Range("A5:R5"), Range("A8:R8"), Range("A11:R11"))
ElseIf Target.Column = 28 And Target.Count = 1 Then
    Transfert Target, Range("A14:R14")
End If
End Sub
 
 
Private Sub Transfert(v As Range, Rng As Range)
Dim c As Range
 
If v.Value <> "" Then
    For Each c In Rng
        If c.Value = v.Value Then
            If c.Offset(1, 0) = "" Then
                Application.EnableEvents = False
                c.Offset(1, 0).Value = Range("X" & v.Row).Value
                Application.EnableEvents = True
                Exit For
            End If
        End If
    Next c
End If
End Sub

[chris09300]

vraiment trop fort.
il faudra que je me penche davantage pour diminuer les longueurs des codes,car les miens sont souvent a rallonge, faute de connaissances
rien a rajouter, nickel
merci beaucoup mercatog
cordialement
cris

[mercatog]

Tu peux modifier le code proposé comme ceci

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
 
If Target.Count = 1 Then
    Select Case Target.Column
        Case 26: Transfert Target, Range("A2:R2")
        Case 27: Transfert Target, Union(Range("A5:R5"), Range("A8:R8"), Range("A11:R11"))
        Case 28: Transfert Target, Range("A14:R14")
    End Select
End If
End Sub
 
 
Private Sub Transfert(v As Range, Rng As Range)
Dim c As Range
 
If v.Value <> "" Then
    For Each c In Rng
        If c.Value = v.Value Then
            If c.Offset(1, 0) = "" Then
                Application.EnableEvents = False
                c.Offset(1, 0).Value = Range("X" & v.Row).Value
                Application.EnableEvents = True
                Exit For
            End If
        End If
    Next c
End If
End Sub

Remarque et relis tout ce sujet, tu sauras que tu ne donne pas assez d'explications aux lecteurs. Il faudra faire une peu d'effort dans ce sens.