[VBA-E]Passer d'une chaîne à un tableau

**rond24** · 06/07/2006, 15h58

Bjr,
je suis tombé sur le code permettant de passer d'une chaîne contenant des espaces à un tableau.
Ce code peut m'intéresser dans la mesure où je cherche à lire une plage de cellules(2000lignes*250c) contenant une chaîne contenant des "_". Je ne connaissais pas la fonction split.Est il possible d'utiliser ce code dans une boucle de type for each ..next qui analyse chacune des cellules de ma plage?
Pour l'instant voici la solution que j'ai trouvé. Mais je ne sais pas s'il n'est pas préférable passer directement par un 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
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
 
Sub SOUS_DESTINATION_TRIPLET()
 
  Dim Type_SD As String             'Fournit le type d'établissement
  Dim Sce_SD As String              'Fournit le service
  Dim Nature_SD As String           'Fournit la nature
  Dim Sousdestination As String     'Fournit la sous-destination
  Dim TRIPLET_SD As Range           'Fournit la plage de données
  Dim Cpt As Long                   'Compteur de cellules contenant des croisements
  Dim c As Object                   'Elément dans la plage de données
  Dim CPT2 As Long                  'Compteur pour la restitution
  Dim Numline As Long               'Fournit le nombre de lignes de la plage
  Dim Numcolonne As Long            'Fournit le nombre de colonnes de la plage
  Dim Valeurlue As String           'Fournit le contenu de la cellule active
  Dim Seekunderscore As Variant     'Fournit la position du "_" dans la chaîne
  Dim Nbcaractere As Integer        'Fournit le nombre de caracatères dans la chaîne
  Dim Nbpositionsnature As Integer  'Fournit le nombre de caractères utilisés pour coder la sous-destination
  Dim Chainesce As String           'Fournit la chaîne pour récupérer dynamiquement le service
  Dim Duree As String               'Durée du traitement
  Dim Duree_deb As Date             'Durée du traitement
  Dim Duree_fin As Date             'Durée du traitement
  Dim Entete As Range               'Entête du tableau de restitution
 
  Application.ScreenUpdating = False
  Duree_deb = Now
 
  ActiveWorkbook.Worksheets("Restitution").Select
  'Suppression des données sur la feuille "Restitution" avant nouvel import
  With Worksheets("Restitution").Range("B:B,C:C,D:D,E:E")
    .Clear
  End With
  'Sélection de la feuille source
  ActiveWorkbook.Worksheets("Source").Select
  ActiveSheet.Cells(1400, 2).Select
  'Insertion du type d'établissement
  ActiveCell.Value = "TYPE ETABLISSEMENT"
  ActiveCell.Offset(0, 1).Select
  'Insertion du service
  ActiveCell.Value = "SERVICE"
  ActiveCell.Offset(0, 1).Select
  'Insertion de la nature
  ActiveCell.Value = "NATURE"
  ActiveCell.Offset(0, 1).Select
  'Insertion de la sous-destination
  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"
  CPT2 = 1401
  'Nombre de ligne de la plage de données
  'Numline = Range("TRIPLET_SD").Rows.Count
  'Nombre de colonnes de la plage de données
  'Numcolonne = Range("TRIPLET_SD").Columns.Count
 
  'Décompte du nombre de croisement nature*service
  'For Each c In Range("TRIPLET_SD")
 
    'If c.Value <> "" Then
      'CPT = CPT + 1
    'End If
 
  'Next c
  'Affichage du nombre de triplets de la base de données
  'MsgBox " Il y'a " & CPT & " triplets"
 
  For Each c In Range("TRIPLET_SD")
 
    Valeurlue = c
 
    If Valeurlue <> "" 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
      Seekunderscore = InStr(1, Valeurlue, "_")
      'Affichage de la postion de "_"
      'MsgBox "Position du underscore " & Seekunderscore
      'Lecture du type d'établissement dans la chaîne codée
      Nbcaractere = Len(Valeurlue)
      Nbpositionsnature = Nbcaractere - (Nbcaractere - (Seekunderscore - 1))
      'MsgBox Nbpositionsnature
      Type_SD = Left(Valeurlue, Nbpositionsnature)
      'Affichage du type d'établissment
      'MsgBox "le type d'établissement est " & Type_SD
      'Lecture de la nouvelle chaîne tronquée, sans le type d'établissement
      Chainesce = Right(Valeurlue, (Nbcaractere - Seekunderscore))
      Seekunderscore = InStr(1, Chainesce, "_")
      'Lecture dynamique du  service dans la nouvelle chaîne
      Sce_SD = Left(Chainesce, (Len(Chainesce) - (Len(Chainesce) - (Seekunderscore - 1))))
      'Affichage du service
      'MsgBox "le service est " & Sce_SD
      'Lecture de la nature dans la chaîne codée
      Nature_SD = Left(Right(Valeurlue, 12), 8)
      'Affichage de la nature
      'MsgBox "la nature est " & Nature_SD
      'Recherche de la position de "_" à partir de la fin dans la chaîne codée
      Seekunderscore = InStrRev(Valeurlue, "_", , vbTextCompare)
      'Affichage de la postion de "_"
      'MsgBox "Position du underscore " & Seekunderscore
      'Nbcaractere = Len(Valeurlue)
      'MsgBox "La chaîne comporte " & Nbcaractere & " caractères"
      Nbpositionsnature = Nbcaractere - Seekunderscore
      'MsgBox "La nature est codée sur " & Nbpositionsnature & " unités"
      'Lecture de la sous-destination dans la chaîne de codes
      Sousdestination = Right(Valeurlue, Nbpositionsnature)
      'MsgBox "la sous-destination est " & Sousdestination
      'MsgBox ActiveCell.Address
 
      'ActiveWorkbook.Worksheets("Restitution").Select
      ActiveSheet.Cells(CPT2, 2).Select
      ActiveCell.Value = Type_SD
      'MsgBox " la première cell de restit" & ActiveCell.Address
      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
 
    End If
 
  Next c
 
  'Export des données vers la feuille restitution
  Range("B1400:E65536").Cut (Worksheets("Restitution").Range("B2"))
 
  ActiveWorkbook.Worksheets("Restitution").Select
 
  'Sélection de l'entête du tableau
  Worksheets("Restitution").Range("B2:E2").Select
 
  'Mise en gras de l'entête du tableau
  Set Entete = Worksheets("Restitution").Range("B2:E2")
  'Entete = Range("B2:E2")
  'MsgBox Entete
  Entete.Font.Bold = True
 
  With Entete
    'On centre horizontalement les cellules
    .HorizontalAlignment = xlCenter
    'On centre verticalement les cellules
    .VerticalAlignment = xlCenter
    'Alignement du texte dans les cellules, retour à la ligne
    .WrapText = True
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    'Ajustement des cellules
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    'Fusion des cellules
    .MergeCells = False
  End With
 
  'Largeur des colonnes
  Columns("B:B").ColumnWidth = 15.71
  Columns("E:E").ColumnWidth = 12.71
 
  With Entete.Interior
    'Couleur arrière-plan cellule
    .ColorIndex = 37
    'Arrière-plan de la cellule
    .Pattern = xlSolid
  End With
 
  'Sélection de la colonne des services
  Worksheets("Restitution").Range("C1:C65536").Select
  'Mise au format du code service sur trois caractères
  Range("C1:C65536").NumberFormat = "000"
 
  Duree_fin = Now
 
  'Calcul du temps de traitement
  Duree = Format(Duree_fin - Duree_deb, "hh:mm:ss")
  Duree = Minute(Duree)
 
  MsgBox "La récupération des sous-destinations avec type d'établissement, service et nature est terminée!!" _
           & vbCrLf + "La récupération s'est effectuée en " & Duree & " mn"
  Application.ScreenUpdating = True
End Sub

Merci.

**repié** · 06/07/2006, 16h58

tu veux pas être un brin plus clair et succins dans ton code stp?

**rond24** · 06/07/2006, 18h55

En fait, je voulais savoir si je peux utiliser la fonction split pour lire une plage de cellule que j'aurais préalablement déclaré en tant que tableau.
Chaque cellule peut être vide ou contenir une chaîne, que je veux découper en 4 éléments et donc les voir apparaître dans un tableau de 4 colonnes.
Je voulais savoir donc si le code présenté dans

vos contributions à VBa mess de flyrol

pouvait m'être utile dans mon cas.
Sachant que le code que j'utilise marche, mais c'est un peu long. Ensuite je suis obligé de couper les données sur ma feuille source et ensuite de les exporter vers une feuille de destination.

Edit AlainTech:
Ajout du lien
http://www.developpez.net/forums/sho...d.php?t=172106

[VBA-E]Passer d'une chaîne à un tableau

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager