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, 
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 
le code VBA pourrait en pâtir Re salut MDO
Rigole, rigole
L’exercice d’après sera de la même conception
Re @Mimimathy,
C’est rigolo 
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 
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)
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_
De plus, j’avais pas mis de FORD Passat ou Coccinelle
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 
tu vas être 
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,
là 
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 
avec ma fille et mes p’tits enfants.
Bon Week-end.
Salut MDO,
Un petit exemple de plan à ma sauce
Bonsoir @Mimimathy,
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,
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, 
Non pour ma part, je n’avais pas boudé l’exercice, mais disons que je n’ais pas apprécié cette phrase: 
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é.
@+
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 
Bon dimanche.