procedure compilant données -

**alexandrek** · 28/01/2011, 15h01

Je ne comprends pas trop cette sub ... pouvez vous me l expliquer un peu

merci d avance

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
 
 
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
 
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
 
Call Transf_Data
Call contpart
Call TypOpe
Call transvalneg
 
End Sub

**pgz** · 28/01/2011, 15h49

Bonjour.

Apparemment, c'est une procédure évènementielle qui se déclenche quand tu sélectionne une cellule en colonne 4 à partir de la ligne 26.

Tu dois avoir des noms définis comme "CLI_1", "CLI_2", ..., "REC1", ... ET ce doit être des noms de cellules.

Si on sélectionne par exemple D28, on fait une concaténation du contenu de CLI-2, REC_2, ... RATE_2 et on range le résultat dans la feuille "Nom" en M2.

Ensuite il y a des appels de procédures sub.

Cordialement,

PGZ

**alexandrek** · 28/01/2011, 16h01

merci bcp

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 :

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
 
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 :

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
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

procedure compilant données -

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager