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
|
Sub SOUS_DESTINATION_TRIPLET()
Dim Type_SD As String
Dim Sce_SD As String
Dim Nature_SD As String
Dim Sousdestination As String
Dim TRIPLET_SD As Range
Dim CPT As Long
Dim c As Object
Dim Donnee As String
Dim Donnee_sce As String
Dim Numligne_SD As String
Dim CelluleNatSd As String
Dim Counter As Integer
Dim CPT2 As Long
Dim CPT3 As Long
Dim CPT4 As Long
Dim CPT5 As Long
Dim CPT6 As Long
Dim Montab As Variant
Dim cmpt1 As Long
Dim Numline As Long
Dim Numcolonne As Long
ActiveWorkbook.Worksheets("Restitution").Select
ActiveSheet.Cells(1, 1).Select
ActiveCell.Offset(1, 1).Select
ActiveCell.Value = "TYPE ETABLISSEMENT"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "SERVICE"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "NATURE"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "SOUS-DESTINATION"
ActiveCell.Offset(1, -3).Select
'Sélection de la plage de données contenant les triplets "TRIPLET_SD
Application.Goto Reference:="TRIPLET_SD"
'Range("TRIPLET_SD").Item(CPT4, CPT5).Select
'Donnee = Range("TRIPLET_SD").Item(CPT4, CPT5)
'MsgBox "la valeur lue de donnée est " & Donnee
CPT3 = 1
CPT4 = 1
CPT2 = 2
'Cells(1, 1).Select
'ActiveCell.Value = Range("TRIPLET_SD").Columns.Count
Numline = Range("TRIPLET_SD").Rows.Count
Numcolonne = Range("TRIPLET_SD").Columns.Count
'MsgBox Numline
'MsgBox Numcolonne
For CPT6 = 1 To Numline
For CPT5 = 1 To Numcolonne
Range("TRIPLET_SD").Item(CPT3, CPT4).Select
Donnee = Range("TRIPLET_SD").Item(CPT3, CPT4)
'MsgBox "la valeur lue de donnée est " & Donnee
If ActiveCell.Value = "" Then
GoTo Line
End If
'If c.Value <> "" Then
'Affichage des coordonnées de la première cellule de la plage
'MsgBox ActiveCell.Address
'Affichage du contenu de la première cellule de la plage
'MsgBox ActiveCell.Value
'Lecture du contenu de la cellule active
Donnee = ActiveCell.Value
'Lecture du type d'établissement dans le triplet de la cellule active
Type_SD = Left(Donnee, 5)
'Affichage du type d'établissment
'MsgBox "le type d'établissement est " & Type_SD
'Lecture du couple service*nature dans le triplet de la cellule active
Donnee_sce = Right(Donnee, 12)
'Lecture du service dans le couple
Sce_SD = Left(Donnee_sce, 3)
'Affichage du service
'MsgBox "le service est " & Sce_SD
'Lecture de la nature
Nature_SD = Right(Donnee, 8)
'Affichage de la nature
'MsgBox "la nature est " & Nature_SD
'MsgBox " la valeur du cpt est " & CPT
'Récupération du numéro de ligne
'MsgBox ActiveCell.Row
Numligne_SD = ActiveCell.Row
'Positionnement sur la cellule contenant nature*sous-destination
Cells(Numligne_SD, 2).Select
'MsgBox ActiveCell.Address
'Récupération du contenu de la cellule
CelluleNatSd = ActiveCell.Value
'Lecture de la sous-destination
Sousdestination = Right(CelluleNatSd, 3)
'MsgBox "la sous-destination est " & Sousdestination
'CPT2 = 2
'Dim Montab As Variant, cmpt1 As Long, cmpt2 As Long
ActiveWorkbook.Worksheets("Restitution").Select
'Montab = Range("B3:E65535").Value
'Montab = Range(Cells(CPT2, 1), Cells(65535, 4)).Value
ActiveSheet.Cells(CPT2 + 1, 2).Select
'MsgBox " cellule active de mon tab" & ActiveCell.Address
'For cmpt1 = 1 To CPT
'Montab.Item(cmpt1, 1).Value = Left(Donnee, 5)
'Montab(cmpt1, 2) = Sce_SD
'Montab(cmpt1, 3) = Nature_SD
'Montab(cmpt1, 4) = Sousdestination
'Next cmpt1
'Range("A1:J65535").Value = Montab
'CPT2 = 2
'ActiveWorkbook.Worksheets("Restitution").Select
'ActiveSheet.Cells(CPT2, 1).Select
ActiveCell.Value = Type_SD
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sce_SD
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Nature_SD
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sousdestination
'ActiveCell.Offset(1, -3).Select
'MsgBox ActiveCell.Address
'CPT2 = CPT2 + 1
CPT2 = CPT2 + 1
'End If
ActiveWorkbook.Worksheets("Feuil1").Select
Range("TRIPLET_SD").Item(CPT3, CPT4).Select
MsgBox ActiveCell.Address
'End If
Line:
CPT4 = CPT4 + 1
'MsgBox "la colonne de la deuxième cellule est " & CPT4
'MsgBox ActiveCell
Next
CPT3 = CPT3 + 1
Next
'For Each c In Range("TRIPLET_SD")
'If c.Value <> "" Then
'CPT = CPT + 1
'End If
'Next c
'MsgBox " Il y'a " & CPT & " triplets"
End Sub |
