[RESOLU] Cerveau 1 - Ordinateur 0! Tableau et tri automatique

[kabol]

Bonjour,

Je me suis fais une macro sous Excel en mode enregistrement automatique résolvant mon problème, mais le code est vraiment, mais vraiment moche!
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 mon 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:
*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,

 

[pierrejean]

Re : Cerveau VS Ordinateur! Tableau et tri automatique

bonjour kabol

Et bienvenue sur XLD

Nous sommes prets à t'assister mais .....
pas a construire un fichier reproduisant ce que tu as du avoir beaucoup de peine à ecrire dans le fil !!!
Alors tu ajoutes ton fichier et tu auras certainement une, voire plusieurs réponses, à ton problème

 

[kabol]

Re : Cerveau VS Ordinateur! Tableau et tri automatique

Merci pour la réponse, donc pas de problème je poste un fichier Excel de test.

En fait 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 l'idée en postant ma question sur ce forum de passionnés, c'est de trouver des gens m'aidant à faire le gros œuvre. Car pour avoir dans le passé pas mal programmé je sais qu'un habitué va réussir à faire en qeulques minutes ce qu'un non newbie mettra plusieurs jours.

Et pour info, ayant posté la question aussi sur un autre forum, j'ai eu la réponse d'un certain Mercatog qui m'a proposé le code suivant que je suis entrain d'analyser:

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

Dans le fichier Excel que je joint à ce post toutes les étapes ainsi que le résultat à atteindre sont expliqués.

Donc voila si d'autres passionnés veulent bien me donner un petit coup de main, je les remercie bien par avance.

Bonne journée

 

[pierrejean]

Re : Cerveau VS Ordinateur! Tableau et tri automatique

Re

Vois si cela te convient

 

[kabol]

Re : Cerveau VS Ordinateur! Tableau et tri automatique

Bonjour,

Tout d'abord merci beaucoup pierrejean pour ta contribution et que je confirme que cela marche du tonnerre!

A mon tour je souhaites partager une autre version avec une approche différente qui permet d'arriver aussi au résultat. Cette version m'a été gentiment développé par un certain Mercatog:

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

Donc en tant que newbie en VBA, je me sers de cet exemple pour m'accompagner dans mon apprentissage du langage.
Je vais de ce pas imprimer ta version pierrejean et l'etudier de façon elle aussi approfondie.

Merci encore pour ce partage.

Bonne journée,

 

[pierrejean]

Re : [RESOLU] Cerveau 1 - Ordinateur 0! Tableau et tri automatique

Re

Je n'ai pas encore testé la version de Mercatog
Par contre j'ai refait quelques essais avec la mienne et je l'ai un peu ameliorée:
Ton tableau peut se situer n'importe ou dans la feuille tableau1(par contre il doit etre d'un seul bloc: pas de colonne inserée dans le tableau)
L'ordre des colonnes peut etre changé a loisir

 

[pierrejean]

Re : [RESOLU] Cerveau 1 - Ordinateur 0! Tableau et tri automatique

Re

Vu la version de Mercatog:

La ligne 1 de la feuille resultat est a completer
le tableau1 n'admet pas l'interversion de colonnes
Excellente utilisation des fonctions natives :filtre autofilter ...
Je pense apprendre quelque chose de l'utilisation de Parent

 

[kabol]

Re : [RESOLU] Cerveau 1 - Ordinateur 0! Tableau et tri automatique

Merci encore pour ton aide.

Je finis l'analyse du code de Mercatog et suite à ça je me lance dans l'analyse du code de ta derniere version.
Je suis content d'avoir pu à mon tour, en partageant l'information, te permettre de trouver qqch d'interessant.

Bonne journée,