Microsoft 365 Macro VBA - Fusionner des cellules

[Elegancya]

Bonjour,

C'est la première fois que j'utilise vraiment Excel et je crois, après plusieurs heures de recherche, que pour faire ce que je veux faire il faut que je crée une macro avec VBA.

Ce que j'ai besoin c'est de partir de la cellule A1, puis on compare A1 avec la cellule en-dessous, si elle est vide on la fusionne avec A1, mais si elle est égale à 1 cette cellule devient notre nouveau point de comparaison, puis on la compare avec la cellule en-dessous, etc. Par contre, il faut aussi quant même temps, si on fusionne deux cellules de la colonne A qu'on fusionne les cellules de la colonne B qui correspondent, ces cellules contiennent du texte qui doit être mis soit bout à bout ou qu'il y ait un changement de ligne dans la cellule.

J'ai mis une image en exemple de ce qu'il faut que cela donne. Je vais toujours partir de A1 en descendant, je vais toujours utiliser 1 comme point de comparaison et se sera toujours les cellules de la colonne B qui devront aussi être fusionnées en même temps.

J'ai eu quelque cours de programmation, donc je comprends un peu, par exemple j'imagine qu'il faut utiliser le If, mais le VBA je ne connais pas du tout et j'ai vraiment de la difficulté à bien partir mon code. Pensez-vous pouvoir m'aider.

Merci

 

[mapomme]

Bonjour @Elegancya et bienvenue sur XLD ,

Que voulez-vous qu'on fasse d'une image? Joignez donc un fichier .

 

[mapomme]

Re,

Comme vous êtes nouveau, j'ai (vite) fait un exemple de ce qu'on pourrait coder. Il nous manque des informations qu'une image ne peut pas révéler: y a-t-il des retours à la ligne dans cellules? Si oui qu'en fait-on? Que fait-on des cellules vides de la colonne B par rapport aux retours à la lignes ?
Bref, un exemple à l'image de votre fichier est indispensable...

Le code est dans le module de Feuil1.

 

[Elegancya]

Bonjour,

Merci d'avoir pris le temps de me répondre. Sur ton exemple cela fonctionne, mais lorsque j'ai essayé de l'appliquer à mon fichier cela n'a pas fonctionné malheureusement, il y a une erreur.

Je mets un exemple. Dans l'exemple, j'ai mis peu de ligne (pour ne mettre pas d'informations confidentielles), mais mes fichier devraient avoir entre 500 et 6000 lignes chaque.

Je vais essayer d'expliquer un peu plus ce que je veux faire. Mon objectif est de combiner les informations de ce fichier avec un autre fichier. Dans l'autre fichier sur chaque ligne j'ai des renseignements par rapport à un sujet précis.

Le problème c'est que dans ce fichier des infos sur un sujet précis peuvent être réparties sur plusieurs lignes. Le texte dans la colonne B est associé au sujet d'une ligne spécifique. Le 1 est là pour indiquer lorsqu'il y changement de sujet. Donc quand il y a un 1, c'est le début d'un sujet précis tant qu'il n'y a pas un autre 1. Mon but est donc de combiner le texte, de préférence en faisant un retour à la ligne entre chaque partie, en une seule cellule pour que l'information se retrouve sur une seule ligne. Si la colonne B est vide, il faut quand même garder une ligne, cela veut juste dire qu'il n'y avait pas d'info pour ce sujet.

Si je combine les deux fichiers en ce moment, à cause des infos sur plusieurs lignes, Les informations se sont plus associées aux bonnes lignes. J'espère être clair.

Exemple:
Autre fichier: Ce fichier:
Info 1A Info1B Info 1C 1 Texte Info1
Texte Info1
Info 2A Info2B Info 2C 1 Texte Info2
Texte Info2
Merci encore beaucoup.

 

[Elegancya]

Bonjour,

Encore merci à mapomme, finalement ce que tu avais fait fonctionnait, c'était une mauvaise manipulation de mon côté qui faisait que ça ne fonctionnait pas.

Malheureusement, après des essais je crois que la fusion n'est pas ce qu'il faut pour m'aider. Je pense qu'il faut copier le contenu des lignes sur une seule ligne pour avoir ce que je souhaite.

Voilà ce que j'ai fait pour le moment, mais mon code bug pour le moment au niveau du compteur et je ne sais pas pourquoi. Est-ce que quelqu'un pourrait m'aider?

Merci

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

 

[mapomme]

Bonjour @Elegancya ,

Si on ne fusionne pas les cellules, j'utilise une autre méthode bien plus rapide.
J'ai ajouté de nombreux commentaires dans le code.
Le code est toujours dans le module de Feuil1.

 

[Elegancya]

Salut,

Merci beaucoup beaucoup, ça semble fonctionner. Je vais le tester sur un plus gros fichier.

J'avais créé une autre discussion puisque le sujet n'était plus la fusion de cellules. Je vais la marquer comme résolue et faire le lien vers cette discussion.

Merci encore

 

[mapomme]

Re @Elegancya ,
Mille plus une excuses. J'ai donné une version avec une ligne qui a sauté (celle qui met 1 dans t(n,1) à la création d'une nouvelle ligne utile)
Voici la v2a qui comble l'omission.

 

[Elegancya]

Merci,

Oui, j'avais remarqué que les 1 ne s'ajoutaient pas à toutes les lignes, mais c'était pas très grave puisqu'ils ne sont là que pour savoir quand commence un nouveau sujet/ligne. Merci tout de même d'avoir apporté la modification.