VBA Excel - concatener en fonction d'un Tag

VBA Excel - concatener en fonction d'un Tag - VB/VBA/VBS - Programmation

Marsh Posté le 20-10-2010 à 11:27:30    

J'aimerais pouvoir concatener du texte à partir du moment où il y a un tag=1 dans la case d'à côté...
 
ex:
 
1    TexteA
1    TexteB
0    TexteC
1   TexteD
1   TexteE
1   TexteF
0   TexteG
 
Dans cet exemple les 1 et 0 sont dans une colonne à gauche du texte. J'aimerais pouvoir concatener Texte A et Texte B car il y a une suite de 1 par contre ne rien fairte pour le texte avec les 0. Ensuite, concatener le texte D, E, F car encore une fois il y a une suite de 1... etc..
 
Voici une partie de mont code... dur dur!
 
 
 
Dim conc As String
Dim i, j, n, p As Integer
 
j = 1
i = 1
 
'tant que le tag est egal à 1 faire le reste'
Do While Cells(j, 7) = 1
 
conc = ""
 
 
 
For i = 1 To "derniere ligne"
 
if cells(i,12)=1 then
 
'concatener les cases lorsque le tag 1 est dans la case à gauche'
conc = conc & Chr(10) & Range("I" & (i + 1)).Value
 
 
'mettre le résultat dans une case'
Range("O" & i + 1) = conc

End If
 
Next
 
j = j + 1
 
Loop
'
End Sub


Message édité par ephene le 20-10-2010 à 12:04:44
Reply

Marsh Posté le 20-10-2010 à 11:27:30   

Reply

Marsh Posté le 20-10-2010 à 13:54:53    

HELP!!!

Reply

Marsh Posté le 20-10-2010 à 14:21:01    

Essaie le code ci-dessous
 
a remplacer les valeurs des constantes par les vrais n° de colonne de tes données ainsi que le début de la boucle si sur ton fichier les données ne commencent pas a la ligne 1
 
ce code va supprimer les lignes en trop après la concaténation.
 
 
Const COLONNETAG As Integer = 1
Const COLONNETEXTE As Integer = 2
 
Dim ligneDébut As Long
Dim ligneActuelle As Long
Dim ligneFin as Long
 
Dim conc As String
Dim i As Long
 
ligneActuelle = 1
 
Do While ligneActuelle <= ligneFin
 
If Cells(ligneActuelle, COLONNETAG).Value = 1 Then
conc = Cells(ligneActuelle, COLONNETEXTE).Value
ligneDébut = ligneActuelle
 
Do While Cells(ligneActuelle + 1, COLONNETAG).Value = 1 And ligneActuelle <= ligneFin
ligneActuelle = ligneActuelle + 1
conc = conc & Cells(ligneActuelle, COLONNETEXTE).Value
Loop
 
For i = ligneActuelle To ligneDébut + 1 Step -1
Rows(i).Delete
ligneFin = ligneFin - 1
Next i
 
ligneActuelle = ligneDébut
Cells(ligneActuelle, COLONNETEXTE).Value = conc
conc = ""
 
End If
 
ligneActuelle = ligneActuelle + 1
Loop


Message édité par Arwon le 20-10-2010 à 19:47:26
Reply

Marsh Posté le 20-10-2010 à 14:39:20    

Merci pour ce premier jet qui resout une partie du probleme.
 
Par contre, je ne veux pas que les lignes avec les 0 soient surpprimées! Au contraire, elle doivent rester à leur place.
 
J'aimerais que la concatenation se fasse dans la case du premier 1 de chaque serie de 1... dans l'exemple Texte D E F dans la case ou se trouve Texte D (ou dans une case à côté mais au même niveau).
 
Merci pour ton aide

Reply

Marsh Posté le 20-10-2010 à 15:02:24    

les lignes avec des 0 ne sont pas supprimés avec ce code, juste les lignes en trop avec le tag 1
 
dans ton exemple, la case ou se trouve D aura la concaténation de D E F et les lignes E et F seront supprimés. Si tu veux les garder il faudra modifier un peu le code  
 
t'auras :
 
1    TexteATexteB  
0    TexteC  
1   TexteDTexteETexteF  
 0   TexteG


Message édité par Arwon le 20-10-2010 à 15:03:49
Reply

Marsh Posté le 20-10-2010 à 15:28:57    

Du coup si je veux garder les cases du texte E et F mais effecer leur contenu, que dois-je modifier?
 
Je vois que tu as l'air d'en connaitre un rayon donc si tu as une idee... Merci.

Reply

Marsh Posté le 20-10-2010 à 19:41:49    

comme ceci :
 
 
Const COLONNETAG As Integer = 1
Const COLONNETEXTE As Integer = 2
 
Dim ligneDébut As Long
Dim ligneActuelle As Long
Dim ligneFin As Long
 
Dim conc As String
Dim i As Long
 
ligneFin = Cells(ActiveSheet.Rows.Count, COLONNETAG).End(xlUp).Row
 
ligneActuelle = 1
 
Do While ligneActuelle <= ligneFin
 
If Cells(ligneActuelle, COLONNETAG).Value = 1 Then
conc = Cells(ligneActuelle, COLONNETEXTE).Value
ligneDébut = ligneActuelle
 
Do While Cells(ligneActuelle + 1, COLONNETAG).Value = 1 And ligneActuelle <= ligneFin
ligneActuelle = ligneActuelle + 1
conc = conc & Cells(ligneActuelle, COLONNETEXTE).Value
Cells(ligneActuelle, COLONNETEXTE).ClearContents
Loop
 
Cells(ligneDébut, COLONNETEXTE).Value = conc
conc = ""
 
End If
 
ligneActuelle = ligneActuelle + 1
Loop
 
 
si tu veux écrire dans une autre colonne le texte, il te suffit de modifier cette ligne :
 
Cells(ligneDébut, COLONNETEXTE).Value = conc


Message édité par Arwon le 20-10-2010 à 19:49:01
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed