transfert de donnees

**chris09300** · 23/12/2011, 12h55

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** · 23/12/2011, 13h16

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** · 23/12/2011, 13h41

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** · 23/12/2011, 13h46

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** · 23/12/2011, 13h52

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

**mercatog** · 23/12/2011, 13h55

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**mercatog** · 23/12/2011, 19h31

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** · 23/12/2011, 19h56

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** · 23/12/2011, 20h08

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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** · 23/12/2011, 20h45

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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** · 23/12/2011, 21h07

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

transfert de donnees [XL-2007]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager