[XL-2010] VBA - macros chaîne de caractère

1 pièce(s) jointe(s)

VBA - macros chaîne de caractère

Bonjour tout le monde, j'aimerai de l'aide pour un exercice en VBA.

Pièce jointe 144542

Voilà, j'aimerai renvoyer les informations du Tab1 en Tab2 dans un premier temps, ce que j'ai fait partiellement!

Merci d'avance pour tout aide, ou explications !! :D

Bonjour M.Grey,

Tu ne donnes aucune explication concernant les problèmes rencontrés ni les fonctionnalités recherchées...
Comment veux-tu que la communauté puisse te venir en aide ?

Cordialement,
Kimy

C'est a dire qu'on doit renvoyer les informations numéro de magasin, gamme et nb_produit par gamme, contenues dans les colonnes A, D, E et F (Tab1) de la feuille dans une autre feuille, sous le format du second tableau (Tab2). Voila mon code :
Option Explicit

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
Public Sub Magasin()
 
    'Déclarations des variables
 
Dim nb_li_tot As Integer
Dim nb_lign As Integer
Dim i As Integer
Dim l As Integer
Dim Gammes() As String
Dim Calcul() As Integer
Dim nb_cases As Integer
 
    'Création des tableaux qui permettent de récupérer les gammes
 
nb_cases = 3
ReDim Gammes(nb_cases)
ReDim Calcul(2, nb_cases)
 
    'Récupération des noms des gammes
 
For l = 0 To nb_cases - 1
 
    Calcul(0, l) = Len(Worksheets("DATA").Cells(1, 4 + l).Value)
    Calcul(1, l) = InStr(Worksheets("DATA").Cells(1, 4 + l).Value, "_")
    Gammes(l) = Right(Worksheets("DATA").Cells(1, 4 + l).Value, Calcul(0, l) - Calcul(1, l))
 
Next l
 
    'Récupération du nombre de lignes du tableau originel, création du nouveau tableau et des en têtes
 
nb_li_tot = Worksheets("DATA").Cells(1, 1).CurrentRegion.Rows.Count
 
Sheets.Add
 
Worksheets(1).Cells(1, 1).Value = "Num"
Worksheets(1).Cells(1, 2).Value = "Gamme"
Worksheets(1).Cells(1, 3).Value = "nb_prod"
 
    'Remplissage du tableau
 
For i = 2 To nb_li_tot
 
    For l = 0 To 2
 
        nb_lign = Worksheets(1).Cells(1, 1).CurrentRegion.Rows.Count
 
        Worksheets(1).Cells(nb_lign + 1, 1).Value = Worksheets("DATA").Cells(i, 1).Value
 
        Worksheets(1).Cells(nb_lign + 1, 2).Value = Gammes(l)
 
        Worksheets(1).Cells(nb_lign + 1, 3).Value = Worksheets("DATA").Cells(i, 4 + l).Value
 
    Next l
 
Next i
 
i = Worksheets(1).Cells(1, 1).CurrentRegion.Columns.Count
l = Worksheets(1).Cells(1, 1).CurrentRegion.Rows.Count
 
 
Worksheets(1).Range(Cells(1, 1), Cells(1, i)).Font.Bold = True
 
Worksheets(1).Range(Cells(1, 1), Cells(l, i)).Select
 
Selection.HorizontalAlignment = xlCenter
 
End Sub

Devrais-je changer quelques choses ?