[XL-2003] Reconstruire proprement un code issu de l'enregistreur de macros [Résolu]

[kabol69]

Bonjour,


Je me suis fais une macro sous Excel en mode enregistrement automatique résolvant mon problème, mais le code est vraiment moche, affreux, dégeu!
Donc voilà je me demandais si quelqu'un pourrait m'aider à construire une macro un peu plus propre.

Débutant en macro VB Excel, je souhaiterai avoir vos conseil pour régler le problème suivant:

-> Dans une worksheet, j'ai un tableau de la forme suivante

titreA  titreB  titreC  titreD  titreE
vache   ble     10.2.1  ville   valide
cheval  mais    VIDE    ferme   valide
vache   ble     5.2.1   ferme   valide
vache   mais    VIDE    ville   valide
vache   ble     5.4.6   ville   valide
cheval  seigle  100.0.7 ferme   valide
cheval  mais    3.6.1   ville   valide

Hypotheses:
* L'espace doit etre interprété comme séparateur de cellule
*La taille du tableau peut varier et l'emplacement des colonnes aussi. Ici on va travailler avec les colonnes nommées: "titreA" et "titreC", mais leur emplacement peut varier (seul leur nom est connu et fixe). Pour ça j'avais pensé à l'utilisation d'une fonction de calcul de la taille du tableau et une fonction de recherche de titre de colonne.
* Pour ordre de grandeur les tableaux que j'utilise font en moyenne 30 colonnes sur 3000 lignes
* Quand j'écris VIDE: cela signifie que le contenu de la cellule est réellement vide

1/ Je souhaite trouver la colonne "titreC" et utiliser un filtre automatique pour ne garder QUE les lignes NON vide (similaire à l'option "Non Blank" du filtre automatique sous Office 2003). Dans notre cas les lignes 3 et 5 ne doivent plus apparaitre.

2/ Je souhaite trier la colonne "titreC" préalablement filtré de façon croissante. Le probleme qu'on rencontre ici (existant d'ailleurs aussi avec le filtre automatique) c'est que par ex: 10.2.1 sera devant 5.2.1, ce que je voudrai éviter.

3/ Enfin, j'aimerai bien pouvoir filtrer de nouveau le résultat de l'étape précédente suivant la colonne "titreA" en ne gardant que les lignes avec le mot "vache". J'imagine qu'ici aussi la fonction de filtre automatique va être utile

Le resultat obtenu des 3 étapes précédentes devrait avoir la forme suivante:

titreA  titreB  titreC  titreD  titreE
vache   ble     5.2.6   ferme   valide
vache   ble     5.22.3  ville   valide
vache   ble     10.2.1  ville   valide

4/Une fois ce tri effectué, je souhaiterai copier ce résultat dans une autre worksheet et supprimer les colonnes "titreB" et "titreD", afin d'obtenir dans une nouvelle worksheet créé:

titreA  titreC  titreE
vache   5.2.6   valide
vache   5.22.3  valide
vache   10.2.1  valide

5/ Et dernière étape (si pas trop compliqué), je souhaiterai pouvoir insérer une ligne (de la longueur du tableau où toutes les cellules sont fusionnées) et où serait écrit le numéro de section basé UNIQUEMENT sur le premier nombre des cellules de la colonne "titreC" (ex: 5.2.6 -> nombre 5, 10.2.1 -> nombre 10). Cette ligne devra être affiché des que le nombre change.
Donc dans l'exemple cela donnerait:

titreA  titreC  titreE
*** SECTION 5 *********
vache   5.2.6   valide
vache   5.22.3  valide
*** SECTION 10 *******
vache   10.2.1  valide

Merci d'avance pour votre aide,

[mercatog]

Bonsoir
Une code moche peut être embelli et refaçonné de manière à être bien formalisé.
Ci joint proposition (avec certains commentaires) à adapter à ton fichier

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
'---------------------------------------------------------------------------------------
'Sub qui permet de copier les données de la feuille SOURCE vers la feuille DESTINATION et reformatage des données suivant les explications fournies
'//!\\ Adapter dans cette sub les noms des 2 feuilles SOURCE et DESTINATION
'      Adapter aussi les mots  TitreC  et  vache
'---------------------------------------------------------------------------------------
'
Private Sub FormaterDonnees()
Dim c As Range, v As Range
Dim i As Integer
Dim Tb
 
Application.ScreenUpdating = False
'On efface le contenu éventuel de la feuille Destination
Worksheets("DESTINATION").UsedRange.Clear
With Worksheets("SOURCE")
    'On recherche la colonne TitreC
    Set c = .UsedRange.Find("TitreC", LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
        c.CurrentRegion.Copy Worksheets("DESTINATION").Range("A1")
        Set c = Nothing
    End If
End With
With Worksheets("DESTINATION")
    'Suppression des colonnes D ensuite B
    .Columns(4).Delete
    .Columns(2).Delete
    Set c = .Range("A1").CurrentRegion
    'Suppression des lignes ne contenant pas vache en colonne TitreA (colonne 1)
    Call SupprFiltre(c, 1, "vache")
    'Suppression des lignes vides de la colonne TitreC (Colonne 2, qui était colonne 3 avant la suppression de la colonne TitreB)
    Call SupprFiltre(c, 2, "*")
    'On éclate les nombres séparés par le point dans les colonnes D,E et F
    For Each v In Intersect(c, .Range("B:B"))
        Tb = Split(v, ".")
        For i = 0 To UBound(Tb)
            v.Offset(0, i + 2) = Tb(i)
        Next i
    Next v
    Set c = c.Resize(c.Rows.Count, c.Columns.Count + 3)
    'On tri sur D, puis E enfin F
    c.Sort Key1:=.Range("D1"), Order1:=xlAscending, Key2:=.Range("E1"), Order2:=xlAscending, Key3:=.Range("F1"), Order3:=xlAscending, Header:=xlYes
    'On insère une ligne entre sections
    Call SepareSections(c)
    'On supprime les colonnes D,E et F
    .Range("D:F").EntireColumn.Delete
    Set c = Nothing
End With
End Sub
 
'---------------------------------------------------------------------------------------
'Sub qui permet de supprimer les lignes de LaPlage
'dont les cellules de la colonne LaColonne ne répondant
'pas au critères LeCritere
'---------------------------------------------------------------------------------------
'
Private Sub SupprFiltre(LaPlage As Range, ByVal LaColonne As Integer, ByVal LeCritere As String)
 
With LaPlage
    .AutoFilter Field:=LaColonne, Criteria1:="<>" & LeCritere
    .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .Parent.AutoFilterMode = False
End With
End Sub
 
'---------------------------------------------------------------------------------------
'Sub qui permet d'insérer une ligne de titre entre chaque section
'---------------------------------------------------------------------------------------
'
Private Sub SepareSections(Plage As Range)
Dim i As Integer, N As Integer
 
With Plage
    N = .Rows.Count
    With .Parent
        For i = N To 2 Step -1
            If .Range("D" & i) <> .Range("D" & i - 1) Then
                .Rows(i).Insert
                .Range("A" & i) = "SECTION " & .Range("D" & i + 1)
                With .Range("A" & i & ":C" & i)
                    .HorizontalAlignment = xlCenterAcrossSelection
                    .Font.Bold = True
                End With
            End If
        Next i
    End With
End With
End Sub

[kabol69]

Merci Mercatog pour ton aide tres precieuse, je suis entrain de revoir ton code, mais sérieusement cela fait plaisir d'avoir eu une réponse aussi rapide et avec du code bien fait: indenté, commenté,..., bref du vrai code.

Si je te dis ça c'est que vois tu la dernière fois où j'ai codé cela remonte à plus de 10 ans durant mes études où j'ai fais plusieurs années de C, de Java,... Et honnêtement j'adorais la prog. Mais voila, dans mon travail je ne suis plus du tout amené à programmer et donc j'ai perdu mes réflexes même si les principes de programmation, c'est comme le vélo on n'oublie pas.

Donc étant complétement newbie en VBA, je me demandais si elle n'existe pas une aide genre "javadoc API", où toutes les fonctions et objets VBA seraient décrites. Certes il y l'aide dans VBA, mais tout du moins pour celle que j'utilise, je la trouve limité et pas du tout pratique.

Car pour être honnête, mon plus gros probléme en VBA est que je souhaiterai éviter de réinventer la roue et donc avoir la connaissance des fonctions et objets disponibles.

Donc merci d'avance à celui qui pourrait m'indiquer si ce genre de ressource VBA existe.

[mercatog]

Ce site, en plus du forum, est plein d'excellents tutos et FAQ
Tutoriels
FAQ

[mercatog]

Codes précédents adaptés et testés sur ton fichier

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
Private Sub FormaterDonnees()
Dim c As Range, v As Range
Dim i As Integer
Dim Tb
 
Application.ScreenUpdating = False
'On efface le contenu éventuel de la feuille Destination
Worksheets("Tableau2").UsedRange.Clear
With Worksheets("Tableau1")
    'On recherche la colonne TitreC
    Set c = .UsedRange.Find("Reference", LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
        c.CurrentRegion.Copy Worksheets("Tableau2").Range("A1")
        Set c = Nothing
    End If
End With
With Worksheets("Tableau2")
    'Suppression des colonnes E (Statut) ensuite 3 (Nom)
    .Columns(5).Delete
    .Columns(3).Delete
    Set c = .Range("A1").CurrentRegion
    'Suppression des lignes ne contenant pas ATTESTED en colonne Validation (colonne 3 après suppression de la colonne Nom)
    Call SupprFiltre(c, 3, "ATTESTED")
    'Suppression des lignes vides de la colonne Référence
    Call SupprFiltre(c, 4, "*")
    'On éclate les nombres séparés par le point dans les colonnes F,G et H
    For Each v In Intersect(c, .Range("D:D"))
        Tb = Split(v, ".")
        For i = 0 To UBound(Tb)
            v.Offset(0, i + 2) = Tb(i)
        Next i
    Next v
    Set c = c.Resize(c.Rows.Count, c.Columns.Count + 3)
    'On tri sur F, puis G enfin H
    c.Sort Key1:=.Range("F1"), Order1:=xlAscending, Key2:=.Range("G1"), Order2:=xlAscending, Key3:=.Range("H1"), Order3:=xlAscending, Header:=xlYes
    .Columns(1).Copy .Range("I1")
    .Columns(1).Delete
    'On insère une ligne entre sections
    Call SepareSections(c)
    c.EntireColumn.ColumnWidth = 30
    Set c = Nothing
    'On supprime les colonnes E,F et G
    .Range("E:G").EntireColumn.Delete
    .Range("E:E").Copy .Range("F1")
    .Range("F:F").ClearContents
    .Range("F1") = "Resultat"
    .Columns(1).ColumnWidth = 46
End With
End Sub
 
'---------------------------------------------------------------------------------------
'Sub qui permet de supprimer les lignes de LaPlage
'dont les cellules de la colonne LaColonne ne répondant
'pas au critères LeCritere
'---------------------------------------------------------------------------------------
'
Private Sub SupprFiltre(LaPlage As Range, ByVal LaColonne As Integer, ByVal LeCritere As String)
 
With LaPlage
    .AutoFilter Field:=LaColonne, Criteria1:="<>" & LeCritere
    .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .Parent.AutoFilterMode = False
End With
End Sub
 
'---------------------------------------------------------------------------------------
'Sub qui permet d'insérer une ligne de titre entre chaque section
'---------------------------------------------------------------------------------------
'
Private Sub SepareSections(Plage As Range)
Dim i As Integer, N As Integer
 
With Plage
    N = .Rows.Count
    With .Parent
        For i = N To 2 Step -1
            If .Range("E" & i) <> .Range("E" & i - 1) Then
                .Rows(i).Insert
                .Range("A" & i) = "SECTION " & .Range("E" & i + 1)
                With .Range("A" & i & ":I" & i)
                    .Interior.ColorIndex = 24
                    With .Font
                        .Bold = True
                        .ColorIndex = 1
                    End With
                End With
            End If
        Next i
    End With
End With
End Sub

[kabol69]

Bonsoir,


Bref, je disais encore merci mercatog et j'étais un peu scotché de voir que tu codes plus vite que ton ombre




Bonne soirée à tous,