Microsoft 365 Concaténer plusieurs cellules précises en une ligne

Elegancya

XLDnaute Nouveau
Bonjour,

J'ai un problème qui m'empêche d'avancer dans mon projet. J'ai un document Excel avec dans la colonne A des 1 qui désigne un 'sujet' en particulier et dans la colonne B du texte en lien avec ce sujet. Le problème est que le texte peut être sur plusieurs lignes. Donc, s'il y a un 1 dans A1 le texte de B1 est relié, même chose s'il y a un 1 dans A2 et du texte dans B2. Par contre, exemple, si après A2, dans A3 il n'y a pas de 1 mais du texte en B3, alors le texte du B3 est relié à au sujet A2.

J'aimerais donc copier en F#, sur une seule ligne le texte concaténé (avec retour de chariot entre) en lien avec chaque sujet. Donc que le texte de chaque sujet ne soit que sur une seule ligne (l'une à la suite de l'autre) au lieu d'être sur plusieurs, car je vais copier ces lignes dans un autre fichier Excel où il y a d'autres informations sur ses 'sujets' qui sont sur une seule ligne. Si je copie maintenant, les lignes vont être décalés et elles ne vont plus correspondre au bon sujet.

Je mets un exemple avec quelques lignes. J'ai mis dans la case D ce que le résultat devrait donner. Si possible, ajouter dans la case E# un compteur pour que je puisse vérifier le nombre ligne.

Il faut aussi conserver une ligne s'il y a un 1 en A# et pas de texte en B#, pour avoir le bon nombre de ligne.

J'ai réussi à copier toutes les lignes vers F#, mais je n'arrive pas à concaténer les lignes multiples ensemble. Et j'ai mis un 2 à la fin de A#, juste pour savoir quand arrêter. Je vous mets le code que j'utilise pour le moment, mais je ne suis pas très avancé niveau programmation, donc vous allez sûrement le trouver très basique.

Merci de votre aide.

VB:
Sub Test2()

Dim valeur As Integer
Dim souscase As Integer
Dim compteur As Integer
Dim textDep As String
Dim textAjout As String

souscase = 2
compteur = 1
valeur = 1

'Boucle
Do While Range("A" & valeur) <> 2
    textDep = "" & compteur & " "
    Range("E" & compteur) = textDep
    If Range("A" & valeur) = 1 And Range("A" & souscase) = 1 Then
        textAjout = Range("B" & valeur)
        Range("F" & compteur) = (textAjout)
    ' J'arrive à copier facilement une ligne lorsque l'information n'est que sur une seule ligne,
    ' mais c'est lorsqu'il y a plusieurs ligne que ça bloque
     ElseIf Range("A" & valeur) = 1 And Range("A" & souscase) = "" Or Range("A" & valeur) = "" And Range("A" & souscase) = "" Or Range("A" & valeur) = "" And Range("A" & souscase) = 1 Then
        textAjout = Range("B" & valeur)
        Range("F" & compteur) = (textAjout)
    End If
    
    souscase = souscase + 1
    valeur = valeur + 1
    compteur = compteur + 1
    
Loop

End Sub


J'avais aussi essayé quelque chose du gente mais ça ne fonctionnait pas.

Code:
Sub Test1()

Dim valeur As Integer
Dim souscase As Integer
Dim compteur As Integer
Dim textDep As String
Dim textAjout As String

valeur = 1
souscase = 2
compteur = 1

Do Until Range("A" & valeur) = 2
    textDep = "" & compteur & " "
    textAjout = ""
    
    Range("E" & compteur).Value = textDep

    If Range("A" & valeur) = 1 And Range("A" & souscase) = 1 Then
        textAjout = Range("B" & valeur).Value
        Range("F" & compteur).Value = (textDep & textAjout)
        valeur = valeur + 1
        souscase = souscase + 1
    ElseIf Range("A" & valeur) = 1 And Range("A" & souscase) = "" Then
        Do Until Range("A" & valeur) >= 1
                textAjout = Range("B" & valeur).Value
                Range("F" & compteur).Value = (textDep & textAjout & vbCrLf)
                valeur = valeur + 1
                souscase = souscase + 1
                textDep = Range("F" & compteur).Value
        Loop
        
    End If
    compteur = compteur + 1
Loop

End Sub
 
Solution
Bonjour,

mapomme a répondu à mon problème sur une autre discussion. Merci encore.

Elegancya

XLDnaute Nouveau
Bonjour,

mapomme a répondu à mon problème sur une autre discussion. Merci encore.

 

Statistiques des forums

Discussions
311 725
Messages
2 081 947
Membres
101 849
dernier inscrit
florentMIG