Exercice N° 8 - Séparer Lignes et Colonnes

Bonjour à tous

Dans cet exercice, il faut séparer les types de véhicule. Un type sur chaque ligne, avec sa marque et son index

1 « J'aime »

Salut @Mimimathy, :wink:

J’ai vu que ton fichier avait été téléchargé une fois avant moi, je suppose que c’est @kiss6, alors comme j’ai bien travaillé sur l’Exercice N°7, je vais faire une pose et laisser une chance pour notre ami @kiss6 où d’autres.

@+

Re,

Vous rectifierez vous même ma petite erreur de saisie pour la marque VW en FORD :woozy_face:

Re @Mimimathy,

Ça change tout :joy: le code VBA pourrait en pâtir :joy::stuck_out_tongue_winking_eye::rofl:

@+

Re salut MDO

Rigole, rigole

L’exercice d’après sera de la même conception

Re @Mimimathy,

C’est rigolo :stuck_out_tongue_winking_eye: :rofl:

Bon plus sérieusement, voici une proposition:

Option Explicit
Public Sub Séparer_L_C()
    
 Dim Données As Worksheet 'Variable feuille Données
 Dim iTableaux1, iTableaux2, i% 'Variables Tableaux1 & 2 et variables i Boucle For
 Dim ValeursB, ValeursC, ValeursD$
 Dim SéparationSplit() As String 'Variable Scinder une chaîne
 
  Application.ScreenUpdating = False 'Rafraichissement écran accélère l'exécution de la macro
    
   Set Données = Worksheets("Données") 'A partir de la feuille Données
   
    iTableaux1 = 3 'Trouve toutes les lignes a partir de la ligne 3
    iTableaux2 = 3 'Copie sur toutes les lignes a partir de la ligne 3
    
    'Boucle Tant qu'il y a des valeurs colonne B
    Do While Données.Cells(iTableaux1, "B").Value <> ""
     ValeursB = Données.Cells(iTableaux1, "B").Value 'Mémoire Tableaux1 colonne B
     ValeursC = Données.Cells(iTableaux1, "C").Value 'Mémoire Tableaux1 colonne C
     ValeursD = Données.Cells(iTableaux1, "D").Value 'Mémoire Tableaux1 colonne D
 
      'Séparation des chaines de caractère entre chaque point virgule colonne D
      SéparationSplit = Split(ValeursD, ";")
 
        'Boucle For on copie les valeurs B, C, D dans le Tableau2
        'sur chaque lignes des colonnes G, H, I
        For i = 0 To UBound(SéparationSplit)
        'UBound plus grand indice disponible pour la dimension indiquée d'un tableau.
        
          Cells(iTableaux2, "G").Value = ValeursB 'Copie
          Cells(iTableaux2, "H").Value = ValeursC 'Copie
          Cells(iTableaux2, "I").Value = SéparationSplit(i) 'Copie
            
        iTableaux2 = iTableaux2 + 1 'incrémentation compteur Tableaux2 sur chaque lignes
                                    'Boucle Do While
        Next i 'Fin de boucle For
 
        iTableaux1 = iTableaux1 + 1 'incrémentation compteur Tableaux1 sur chaque lignes
                                    'Boucle For
    Loop 'Fin de boucle Do While ( tant que )
    
End Sub

Le fichier ICI==> Séparer L & C V1.xlsm (20,0 Ko)

Mise à part ça, @kiss6 a rendu les armes, je suis désespérément seul :sleepy: et complétement abandonné a ta torture, que c’est triste la vie.

@+

Re MDO

Eh bien là, c’est moins rigolo rigolo (mais rigolo quand même, je ne connaissais pas):call_me_hand:

Le résultat après macro doit apparaitre en colonne B,C et D au même niveau (CàD qu’il efface les autres)

moi je dis _c'est rigolo, c'est rigolo_ :rofl:

De plus, j’avais pas mis de FORD Passat ou Coccinelle :rofl:

Re @Mimimathy,

J’avais anticipé ta demande, enfin si j’ai bien compris, mais ce n’est pas du pur VBA.

Avec une fonction personnalisée RechercheMultiples que du dois certainement connaitre puisqu’elle fait partie de mes archives depuis un bon moment, je l’avais récupéré sur un forum.

J’ai également nommé les plages de cellules colonnes G & H dans le Gestionnaire de noms. Et là c’est pas Rigolo :worried: tu vas être :rage: de colère.

La macro Module1

Option Explicit
Dim c As Range, d As Range, Dico 'Les variables

Sub SansDoublonbBC_et_RechercheMultipleD()
    
    Set Dico = CreateObject("Scripting.Dictionary") 'Creer un dictionnaire m?moire
    For Each c In Range("Index") 'Plage de cellules colonne G
        Dico(CStr(c.Value)) = ""
    Next c
    'Copie sans doublons la colonne G dans la colonne B
    Range("B3").Resize(Dico.Count, 1) = Application.Transpose(Dico.keys)
    
    Set Dico = CreateObject("Scripting.Dictionary") 'Creer un dictionnaire m?moire
    For Each d In Range("Marque") 'Plage de cellules colonne H
        Dico(CStr(d.Value)) = ""
    Next d
    'Copie sans doublons la colonne H dans la colonne C
    Range("C3").Resize(Dico.Count, 1) = Application.Transpose(Dico.keys)
    
    'A partir de D3
    Range("D3").Select
    'Copier la formule =RechercheMultiples
    ActiveCell.FormulaR1C1 = _
     "=RechercheMultiples(RC[-1],R3C8:R38C8,R3C9:R38C9,"""")"
     'Copier jusqu'? le derni?re ligne si la colonne "C" contient une valeur
     Selection.AutoFill Destination:=Range("D3:D" & Range("C65536").End(xlUp).Row)
 
    'Remplace les formules par leurs valeurs
    With ActiveSheet.UsedRange
         .Value = .Value
    End With
    
    Range("G3:I65000").ClearContents 'Efface les donn?es colonnes G, H, I
 
End Sub

La Fonction Module2

'Fonction RechercheV Multicrit?res
Function RechercheMultiples(ValeurCherch?e As String, MatriceCherche, MatriceTrouve, Optional Seprator As String) As String

Dim c, i As Long
    If Separator = "" Then Separator = ";"
        For Each c In MatriceCherche
            i = i + 1
                If ValeurCherch?e = c Then
                    If RechercheMultiples = "" Then
            RechercheMultiples = MatriceTrouve(i)
                Else
            RechercheMultiples = RechercheMultiples & Separator & MatriceTrouve(i)
                    End If
                End If
        Next c

End Function

Le fichier ICI==> Séparer L & C V2.xlsm (22,4 Ko)

@+

1 « J'aime »

Re,

:-1: rien à voir avec mon dossier d’origine

Re @Mimimathy,

Ce n’est pas la première fois que j’entends dire sur les forums de faire un plan de construction sur papier, mais je ne vois pas comment l’imaginer, peux-tu me faire un exemple de ce genre de construction et publier sur le forum le scanne en version PDF pour que je vois à quoi cela ressemble, ça m’aiderai sans doute pour faire les macros, plutôt que de travailler en directe avec mon PC.

D’avance merci.

Ok je vois ce que tu veux dire, en fait tu veux les colonnes G, H, I en colonnes B, C, D en lieu et place des données existantes.
Du genre mémoire provisoire tampon et recopie en B, C, D.

Je regarderai ça un peu plus tard, car demain, c’est jour de sortie :two_women_holding_hands:avec ma fille et mes p’tits enfants.

Bon Week-end.

Salut MDO,

Un petit exemple de plan à ma sauce

Bonsoir @Mimimathy, :wink:

Merci pour ce plan de construction.

Bon aprés avoir passé une journée familiale, je suis en mesure de te proposer la dernière version que j’ai mis au point afin de répondre au cahier des charges.

La macro:

Option Explicit
Public Sub S?parer_L_C()
    
 Dim Donn?es As Worksheet 'Variable feuille Donn?es
 Dim iTableaux1, iTableaux2, i% 'Variables Tableaux1 & 2 et variables i Boucle For
 Dim ValeursB, ValeursC, ValeursD$
 Dim S?parationSplit() As String 'Variable Scinder une cha?ne
 Dim GI As Variant, TabloTampon() As Variant 'Cr?er un tableau tampon Colonnes GI

  Application.ScreenUpdating = False 'Rafraichissement ecran acc?l?re l'execution de la macro
    
   Set Donn?es = Worksheets("Donn?es") 'A partir de la feuille Donn?es
   
    iTableaux1 = 3 'Trouve toutes les lignes a partir de la ligne 3
    iTableaux2 = 3 'Copie sur toutes les lignes a partir de la ligne 3
    
    'Boucle Tant qu'il y a des valeurs colonne B
    Do While Donn?es.Cells(iTableaux1, "B").Value <> ""
     ValeursB = Donn?es.Cells(iTableaux1, "B").Value 'M?moire Tableaux1 colonne B
     ValeursC = Donn?es.Cells(iTableaux1, "C").Value 'M?moire Tableaux1 colonne C
     ValeursD = Donn?es.Cells(iTableaux1, "D").Value 'M?moire Tableaux1 colonne D
 
      'S?paration des chaines de caract?re entre chaque point virgule colonne D
      S?parationSplit = Split(ValeursD, ";")
 
        'Boucle For on copie les valeurs B, C, D dans le Tableau2
        'sur chaque lignes des colonnes G, H, I
        For i = 0 To UBound(S?parationSplit)
        'UBound plus grand indice disponible pour la dimension indiqu?e d?un tableau.
        
          Cells(iTableaux2, "G").Value = ValeursB 'Copie
          Cells(iTableaux2, "H").Value = ValeursC 'Copie
          Cells(iTableaux2, "I").Value = S?parationSplit(i) 'Copie
            
        iTableaux2 = iTableaux2 + 1 'incr?mentation compteur Tableaux2 sur chaque lignes
                                    'Boucle Do While
        Next i 'Fin de boucle For
 
        iTableaux1 = iTableaux1 + 1 'incr?mentation compteur Tableaux1 sur chaque lignes
                                    'Boucle For
                                    
    Loop 'Fin de boucle Do While ( tant que )
    
    GI = Range("G3").CurrentRegion 'Plage autour de G2
    Range("B3").Resize(UBound(GI, 1), UBound(GI, 2)) = GI
    'Copie et redimentionne le TabloTampon toutes les lignes et toutes le colonnes

        With Range("D2:D65000") 'Centre le r?sultat en colonne D
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
        End With

    Range("G2:I65000").Clear 'Supprime le TabloTampon
    
End Sub

Le fichier ICI==> Séparer L & C .xlsm (359,5 Ko)

@+

Salut @Mimimathy, :wink:

Modif de la dernière ligne de code.

Range("G2:I65000").Clear 'Supprime le TabloTampon

Par:

GI = Range("G2").CurrentRegion.Clear 'Supprime le TabloTampon

Bon dimanche.

Salut MDO,

Pas mal, mais tu as “Triché” un peu.

Bonjour à tous,

Comme l’exercice est boudé, je donne la solution

Salut @Mimimathy, :wink:

Non pour ma part, je n’avais pas boudé l’exercice, mais disons que je n’ais pas apprécié cette phrase: :face_with_raised_eyebrow:

Certes, je m’aide pour trouver la solution à tes exercices d’internet, mais de là a laisser penser que je n’ais fait que copier un code sans avoir travaillé ce n’ai pas juste venant de ta part.

Alors pourquoi mes variables étaient mal déclarées ?

Parce-que il m’avait semblé comprendre qu’en déclarant sur une seule ligne de code plusieurs variables ( dans ce cas STRING ) le fait de mettre la dernière variable ( $ ) prenait en compte toute la ligne.
Et comme le code fonctionnait, il m’avait semblé avoir trouvé quelque chose d’intéressant.

Mais ton explication, m’a prouvé le contraire et que je commettais là une erreur, d’où l’intérêt de tes exercices pédagogiques.

Alors voici le travail que j’ai fais pour résoudre l’Exercice N°8 tel que tu souhaitais avoir le résultat dans les même colonne « B, C, D »

Dans la colonne « D » pour chaque ligne séparée d’un point virgule je crée une ligne pour chaque mot ceci dans une boucle jusqu’au dernier mot de de la dernière ligne.

Ensuite pour les colonnes « B & C » avec une formule je comble chaque ligne vide crée par la colonne « D » par la cellule non vide du dessus.

Mon code est différent du tien et tu me corrigeras, mais il est fonctionnel.

Le code:

Option Explicit
Sub Separe_ligne_colonne()
Dim Donn?es As Worksheet 'Variable feuille Donn?es
Dim Tableau() As String 'Variable Tableau
Dim i% 'Variable de boucle For dans boucle Do
Dim X$ 'Variable suite de caract?re
Dim D%, y% 'Varables boucle For pour combler cellules vides
Application.ScreenUpdating = False 'Rafraichissement ecran acc?l?re l'execution de la macro

 Set Donn?es = Worksheets("Donn?es") 'A partir de la feuille Donn?es
  Cells(3, 4).Activate 'Active la cellule D3
  
    Do 'Boucle faire (Effectuer, faire les actions qui suivent)

     X = ActiveCell.Value '1er, 2?me et ainsi de suite chaine de caract?re
     Tableau = Split(X, ";") 'Tableau s?paration chaine de caract?re par point virgule

     For i = 0 To UBound(Tableau) 'Dimentionne le tableau de 0 ? chaine de caract?re
     ActiveCell.Value = Tableau(i) 'Pour chaque chaine cr?e un tableau

     '******************************************************************************
     'Cr?ation d'une nouvelle plage avec rowoffset:=0,columnoffset:=0
     'rowoffset:=1 = ? D3 et d?calage vers le bas, D4, D5 etc...
     'columnoffset:=0 = ? colonne D sans d?calage
     '******************************************************************************
     ActiveCell.Offset(rowoffset:=1, columnoffset:=0).Activate
     'Si  le tableau est diff?rent alors copie la plage en inserant chaque ligne
     If i <> UBound(Tableau) Then Selection.EntireRow.Insert
     
     Next i 'Fin de la boucle For

    Loop Until ActiveCell = "" 'Jusqu'? ce que (Jusqu'? ce que X soit vide)
    
    With Range("D2:D65000") 'Centre le r?sultat en colonne D
     .HorizontalAlignment = xlCenter
     .VerticalAlignment = xlBottom
    End With
    
'***********************************************************************************
'A la fin de cette macro, on comble les cellules vides
'on copie en face de chaque ligne colonne D vide
'les lignes du dessus pour chaque colonnes B & C
'***********************************************************************************

D = Range("D65000").End(xlUp).Row

    For y = 2 To D
     If Range("B" & y) = "" Then Range("B" & y) = Range("B" & y - 1)
     If Range("C" & y) = "" Then Range("C" & y) = Range("C" & y - 1)
    Next
    
End Sub

Le fichier Séparer L & C .xlsm (362,0 Ko)

Amicalement.

Salut MDO,

Désolé de t’avoir froissé

Re @Mimimathy,

Oui, j’avais bien tout lu, mais je n’ais pas copier / coller.

Ceci étant dit n’en parlons plus, tout le monde peut avoir des humeurs, cela arrive même aux meilleurs d’entre nous.

Comme j’attendais que tu fasses signe avant de mettre ma solution sur le forum, j’attends de ta part que tu me dises ce que tu penses de la solution trouvé.

Bien sûr, j’ai noté la tienne, afin de pouvoir m’y rapporter en cas de nécessité.

@+ :wink:

Re MDO

Regarde avec ta version qui est excellente

Re @Mimimathy,

En effet, je n’avais pas du tout testé cette éventualité, il me manque encore beaucoup d’expérience en VBA et surtout les bons réflexes pour analyser les conséquences qu’un code peut produire sur le reste d’un fichier.

Y’a encore du taf, mais on progresse en pratiquant, il faut dire aussi que ce n’ai pas chose aisée quand on connait très peu les instructions du VBA sachant que mon anglais est proche de zéro.

Mais peu à peu a force de chercher ce que les instructions veulent signifier, ça rentre dans ma mémoire, cela dit, c’est pas tout aussi simple quant la jeunesse n’est plus :tired_face:

Bon dimanche.