Distribution d une concaténation sous condition

Version imprimable

merci d avance sincerement

donc cette procédure se situe ds la page en question .... une dernière question etant donné que je dois copier coller chacune des plages déterminées ds ce code pensez vous que ce code pourrait marcher

Donc ds ma page active ou je veux declencher cet evenement a partir d un clique sur une cellule colone D dc je dois inserer cela si je me trompe pas

Code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Private Sub Workbook_Open()
 
 
   Call CréatNoms
 
End Sub
 
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
 
Call crea_page
'Call Select_Data
'Call varcop
Call contpart
Call TypOpe
Call transvalneg
 
 
End Sub

en faite je veux à travers ce code faire une concatenation par exemple si je clique sur D28 de tout les CLI_2 ...REC_2 et ensuite les envoyer ds un petit tableau en faite je pense mal m y prendre

dc ensuite ds mon module je cree la page et le tableau
je selectione donc les data de la concatenation, je copie mes variables selon la destination

ce code peut il le faire
dc vu q on range en Feuille Nom en M2 c est pas bon mais je sais pas comment les faire aller comme j indique ds Determine destination variables ds "deal" worksheet

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
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
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
 
Public Sub CréatNoms()
 
 
Dim débnoms As Range
Dim listnoms As Range
Dim nom As Range
Dim i As Integer
 
Set débnoms = Sheet("BOOK").Range("A26")
 
Set listnoms = Range(débnoms, débnoms.End(xlToRight))
 
For Each nom In listnoms
   For i = 1 To 50
        ActiveWorkbook.Names.Add Name:=nom.Value & "_" & i, RefersToR1C1:=nom.Offset(i, 0)
    Next
Next
 
End Sub
 
Sub crea_page()
'
'
'   Création nouvelle page avec le numero du deal
 
Set MaFeuille = ActiveSheet
 
nom = ActiveCell.Value
 
 
'On verifie que le nom n'existe pas déjà
On Error Resume Next 'en cas d'erreur, on continu sans generer d'erreur
Set MaNewFeuille = Sheets(nom)
On Error GoTo 0 'on réactive la gestion d'erreur
'On verifie si la variable a obtenu un objet ou non
If Not MaNewFeuille Is Nothing Then message = MsgBox("Voulez vous ?", vbRetryCancel + vbQuestion, "Mon programme")     'Exit Sub ' Si elle existe déjà Msg soit annule ou remplace
 
 
'Sinon on continu
'Add retourne un objet Worksheet, que tu recupere dans MaNewFeuille
Set MaNewFeuille = Sheets.Add(After:=Sheets(Sheets.Count))
 
'Renome la nouvelle feuille
MaNewFeuille.Name = nom
 
 
 
'   Creation tab et mise en page
 
 
Sheets("REF").Select
Range("A1:E17").Select
    Selection.Copy
    Sheets(nom).Select
    ActiveSheet.Paste
 
    Columns("B:B").ColumnWidth = 20.29
    Columns("C:C").ColumnWidth = 6.29
    Columns("D:D").ColumnWidth = 15.43
    Rows("3:3").RowHeight = 20.25
    Rows("4:4").RowHeight = 15.75
    Rows("5:5").RowHeight = 15.75
    Rows("6:6").RowHeight = 15.75
    Rows("7:7").RowHeight = 15.75
    Rows("8:8").RowHeight = 15.75
    Rows("9:9").RowHeight = 15.75
    Rows("10:10").RowHeight = 15.75
    Rows("11:11").RowHeight = 15.75
    Rows("12:12").RowHeight = 15.75
    Rows("13:13").RowHeight = 15.75
    Rows("14:14").RowHeight = 15.75
    Rows("15:15").RowHeight = 15.75
    Rows("16:16").RowHeight = 15.75
 
     Range("C4:D4").ClearContents
     Range("C6:D8").ClearContents
     Range("C10:D16").ClearContents
 
 
With Range("C13:D13")
   .Font.Bold = False
   .Font.Bold = True
   .Font.Italic = False
   .Font.Italic = True
End With
 
 End Sub
 
 
 
Sub Select_Data()
 
' regroupement des données
 
Dim listdon As Variant
Dim lign As Byte
Dim donexp As String
 
 
 
With Target
        If .Column <> 4 Or .Row < 27 Then Exit Sub
        lign = .Row - 26
        listdon = Array("CLI", "REC", "PAY", "PAY", "DS", "SF", "VD", "AMCCY1", "AMCCY2", "CCYO", "CCYT", "RATE")
        donexp = ""
        For Each donnée In listdon
                donexp = donexp & Range(donnée & "_" & lign)
        Next donnée
        Sheets(nom).Range("M" & lign).Value = donexp
End With
 
 
 
End Sub
 
 
'   Déclarer variables à copier sachant que chaque variable va etre numerote dc il faut mettre les rec_1 avec tout les autres en _1 et renvoyer chacune ds le champs du ticket
 
Sub varcop(ByVal Target As Range)
 
    Dim CLI As Range
 
    Dim REC As Range
 
    Dim PAY As Range
 
    Dim DS As Range
 
    Dim SF As Range
 
    Dim VD As Range
 
    Dim AMCCY1 As Range
 
    Dim AMCCY2 As Range
 
    Dim CCYO As Range
 
    Dim CCYT As Range
 
    Dim RATE As Range
 
 
 
'  Determine destination variables ds "deal" worksheet
 
 With Target
 
    For i = 1 To 50
 
        Set CLI = CLI & "_" & i = Sheets(nom).Range("C6:D6")
 
        Set REC = REC & "_" & i = Sheets(nom).Range("C14:D14")
 
 
        Set PAY = PAY & "_" & i = Sheets(nom).Range("C15:D15")
 
 
        Set DS = DS & "_" & i = Sheets(nom).Range("C4:D4")
 
 
        Set SF = SF & "_" & i = Sheets(nom).Range("C7:D7")
 
 
        Set VD = VD & "_" & i = Sheets(nom).Range("C8:D8")
 
 
    If Worksheets("2401").Range("G27").Value > 0 Then
        Set AMCCY1 = AMCCY1 & "_" & i = Sheets(nom).Range("D11")
    Else
        Set AMCCY2 = AMCCY2 & "_" & i = Sheets(nom).Range("D12")
    End If
 
 
    If Worksheets("2401").Range("H27").Value < 0 Then
        Set AMCCY2 = AMCCY2 & "_" & i = Sheets(nom).Range("D12")
    Else
        Set AMCCY2 = AMCCY2 & "_" & i = Sheets(nom).Range("D11")
    End If
 
    If Worksheets("2401").Range("G27").Value > 0 Then
        Set CCYO = CCYO & "_" & i = Sheets(nom).Range("C11")
    Else
        Set CCYO = CCYO & "_" & i = Sheets(nom).Range("C12")
    End If
 
    If Worksheets("2401").Range("H27").Value < 0 Then
        Set CCYT = CCYT & "_" & i = Sheets(nom).Range("C12")
    Else
        Set CCYT = CCYT & "_" & i = Sheets(nom).Range("C11")
    End If
 
        Set RATE = RATE & "_" & i = Sheets(nom).Range("C13:D13")
 
End With
   Next i
 
 
'   Transfer PO data
 
 Dim intcount As Integer
    For intcount = 1 To 11
        For i = 1 To 10
            Select Case intcount
            Case 1: CLI = CLI & "_" & i = Range(CLI & "_" & i)
            Case 2: REC = REC & "_" & i = Range(REC & "_" & i)
            Case 3: PAY = PAY & "_" & i = Range(PAY & "_" & i)
            Case 4: DS = DS & "_" & i = Range(DS & "_" & i)
            Case 5: SF = SF & "_" & i = Range(SF & "_" & i)
            Case 6: VD = VD & "_" & i = Range(VD & "_" & i)
            Case 7: AMCCY1 = AMCCY1 & "_" & i = Range(AMCCY1 & "_" & i)
 
                    'AMCCY1 = AMCCY1 & "_" & i.NumberFormat = "0.0000"
 
            Case 8:  AMCCY2 = AMCCY2 & "_" & i = Range(AMCCY2 & "_" & i)
 
                     'AMCCY2 = AMCCY2 & "_" & i.NumberFormat = "0.0000"
 
            Case 9: CCYO = CCYO & "_" & i = Range(CCYO & "_" & i)
            Case 10: CCYT = CCYT & "_" & i = Range(CCYT & "_" & i)
            Case 11: RATE = RATE & "_" & i = Range(RATE & "_" & i)
        End Select
        Next i
    Next intcount
 
End Sub

le probleme de mon programme se trouve la ds select_data et varcop ... mais alors le trouver je pense je m y prends mal pr la destination en fonction de la concatenation ...

MERCI D AVANCE

28/01/2011, 17h43
lvr
Pourrais-tu mieux décrire ce que tu souhaites faire et le faire séquentiellement, car là c'est peu compréhensible.

En plus ton code est peu lisible !!!

C'est quoi cette structure ?

Code:

Set VD = VD & "_" & i = Sheets(nom).Range("C8:D8")

Je ne comprends pas non plus la partie
Code:

1 2 3 4 5 6 For Each nom In listnoms For i = 1 To 50 ActiveWorkbook.Names.Add Name:=nom.Value & "_" & i, RefersToR1C1:=nom.Offset(i, 0) Next Next
Pourquoi crées-tu des Names que tu ne réutilises pas après ?
28/01/2011, 17h55
alexandrek
tout d abord merci pr ton aide

En faite,

pr etre precis, je cherche a qd je selectionne une cellule ds la colone D de la page active à rassembler les données concernant cette cellule d ou la concatenation .....

ensuite une fois nommées et rassemblées je veux renvoyer ces données ds un petit tableau
Code:

1 2 Set VD = VD & "_" & i = Sheets(nom).Range("C8:D8")
en faite je définis VD une date ayant comme destination 'C8,D8' et vu que il y aura un VD_1 et plusieurs VD_
je pensais faire cela pour que par exemple qd je clique la cellule D27 il rassemble toutes les données CLI_2, VD_2 ....
et renvoyées ces dernieres vers leur destination ....

a travers cette phrase de code je pensais que si VD est égale a VD_2 par exemple il renverra vers C8,D8 sachant qil peut y avoir un VD_50 un if ne suffirait pas ...

peut etre je ne suis pas obligé de faire une concatenation pour rassembler les données correspondants a une cellule cliquée pour les copier coller ds un tableau sous condition

on m a proposé une formule pr select les datas a cote mais je vois pas comment l appliquer pour coller les données en fonction de mon code
Code:

1 2 3 4 5 6 7 8 9 Public Sub select_data_() For i = 1 To 10 If Selection = Range("D" & i) Then Selection = Range("A" & i, ActiveCell.Offset(0, 12)) End If Next i End Sub
je sais pas d ou ma demande

en tout cas un grand merci à tous

merci d avance

voila après cette concaténation, je voudrais mettre si je clique D27
mettre CLI_1 ds Sheets(nom).Range("C6,D6"), REC_1 dans Sheets(nom).Range("C14,D14")
..... PAY_1 ds Sheets(nom).Range("C15,D15"),
DS_1 dans Sheets(nom).Range("C4,D4"),
SF dans Sheets(nom).Range("C7,D7"), VD_1 dans Sheets(nom).Range("C8,D8")
et mettre RATE_1 ds Sheets(nom).Range("C13,D13")

et apres la destination de AMCY1_1 serait sous condition comme ici, pareil pr AMCY2_1 , pareil pour CCYO_1 et CCYT_1
sachant que si je clique D28 ça sera les memes noms CLI,REC .... mais avec le N°2 ... comme CLI_2 ... mais la destination restera la meme Sheets(nom).Range("C6,D6"), pour CLI_2 .........................

mon probleme reside ds la distribution de ces données concaténées ....

j'ai rédigé ce code mais je pense je m y prends mal :( je suis réellement bloqué ... merci d avance

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
 
 
Sub Select_Data(ByVal Target As Range)
 
' regroupement des données
 
Dim listdon As Variant
Dim lign As Byte
Dim donexp As String
Dim i As Integer
 
 
 
    With Target
            If .Column <> 4 Or .Row < 27 Then Exit Sub
            lign = .Row - 26
            listdon = Array("CLI", "REC", "PAY", "PAY", "DS", "SF", "VD", "AMCCY1", "AMCCY2", "CCYO", "CCYT", "RATE")
            donexp = ""
        For Each donnée In listdon
            donexp = donexp & Range(donnée & "_" & lign)
        Next donnée
        Sheets(nom).Range("M" & lign).Value = donexp
    End With
 
'For i = 1 To 10
       ' If Selection = Range("D" & i) Then
       ' Selection = Range("A" & i, ActiveCell.Offset(0, 12))
       ' End If
'Next i
 
 
 
End Sub
 
 
'   Déclarer variables à copier sachant que chaque variable va etre numerote dc il faut mettre les rec_1 avec tout les autres en _1 et renvoyer chacune ds le champs du ticket
 
Sub varcop(ByVal Target As Range)
 
    Dim CLI As Range
    Dim REC As Range
    Dim PAY As Range
    Dim DS As Range
    Dim SF As Range
    Dim VD As Range
    Dim AMCCY1 As Range
    Dim AMCCY2 As Range
    Dim CCYO As Range
    Dim CCYT As Range
    Dim RATE As Range
 
 
 
'  Determine destination variables ds "deal" worksheet
 
 With Target
 
    For i = 1 To 50
 
        Set CLI = CLI & "_" & i = Sheets(nom).Range("C6:D6")
        Set REC = REC & "_" & i = Sheets(nom).Range("C14:D14")
        Set PAY = PAY & "_" & i = Sheets(nom).Range("C15:D15")
        Set DS = DS & "_" & i = Sheets(nom).Range("C4:D4")
        Set SF = SF & "_" & i = Sheets(nom).Range("C7:D7")
        Set VD = VD & "_" & i = Sheets(nom).Range("C8:D8")
 
 
    If Worksheets("2401").Range("G27").Value > 0 Then
        Set AMCCY1 = AMCCY1 & "_" & i = Sheets(nom).Range("D11")
    Else
        Set AMCCY2 = AMCCY2 & "_" & i = Sheets(nom).Range("D12")
    End If
 
 
    If Worksheets("2401").Range("H27").Value < 0 Then
        Set AMCCY2 = AMCCY2 & "_" & i = Sheets(nom).Range("D12")
    Else
        Set AMCCY2 = AMCCY2 & "_" & i = Sheets(nom).Range("D11")
    End If
 
    If Worksheets("2401").Range("G27").Value > 0 Then
        Set CCYO = CCYO & "_" & i = Sheets(nom).Range("C11")
    Else
        Set CCYO = CCYO & "_" & i = Sheets(nom).Range("C12")
    End If
 
    If Worksheets("2401").Range("H27").Value < 0 Then
        Set CCYT = CCYT & "_" & i = Sheets(nom).Range("C12")
    Else
        Set CCYT = CCYT & "_" & i = Sheets(nom).Range("C11")
    End If
 
        Set RATE = RATE & "_" & i = Sheets(nom).Range("C13:D13")
 
End With
   Next i
 
 
'   Transfer PO data
 
 Dim intcount As Integer
    For intcount = 1 To 11
        For i = 1 To 10
            Select Case intcount
            Case 1: CLI = CLI & "_" & i = Range(CLI & "_" & i)
            Case 2: REC = REC & "_" & i = Range(REC & "_" & i)
            Case 3: PAY = PAY & "_" & i = Range(PAY & "_" & i)
            Case 4: DS = DS & "_" & i = Range(DS & "_" & i)
            Case 5: SF = SF & "_" & i = Range(SF & "_" & i)
            Case 6: VD = VD & "_" & i = Range(VD & "_" & i)
            Case 7: AMCCY1 = AMCCY1 & "_" & i = Range(AMCCY1 & "_" & i)
 
                    'AMCCY1 = AMCCY1 & "_" & i.NumberFormat = "0.0000"
 
            Case 8:  AMCCY2 = AMCCY2 & "_" & i = Range(AMCCY2 & "_" & i)
 
                     'AMCCY2 = AMCCY2 & "_" & i.NumberFormat = "0.0000"
 
            Case 9: CCYO = CCYO & "_" & i = Range(CCYO & "_" & i)
            Case 10: CCYT = CCYT & "_" & i = Range(CCYT & "_" & i)
            Case 11: RATE = RATE & "_" & i = Range(RATE & "_" & i)
        End Select
        Next i
    Next intcount
 
End Sub