Mise en loop d'une macro de fusion

Bonjour à tous !

Alors, je suis face à un petit soucis que je ne parvient pas à résoudre...

Je vous explique, j'ai un document d'historique de conversation sms, j'ai un peu modifier le document sortit du téléphone pour lui créer trois colonnes principales (qui sont les colonnes E, F et G). J'ai mis les messages dans les cases de la colonne F (du texte donc). J'ai un autre colonne (J) dans laquelle j'ai soit la valeur "RCV" (reçu) soit la valeur "SNT". Voilà pour la situation.

Mon soucis est que je voudrais que sur une ligne où j'ai la valeur "SNT" en J, la case en F fusionne avec la case vide en E. Et que sur une ligne où j'ai la valeur "RCV" en J, la case F fusionne avec la case vide en G.

J'ai trouvé un bout de code qui me fait ça ligne par ligne (enfin une des deux conditions à la fois, mais au pire je lancerais deux macros ça ne me dérange pas...) :

(exemple pour la ligne 1)

Sub test()
Range("E1:F1").UnMerge
If [J1] = "SNT" Then
    With Range("E1:F1")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .MergeCells = True
    End With
End If
End Sub

Là ça fonctionne sur la ligne 1, pas de soucis, la case J contient "SNT" donc la case F fusionne bien avec la case E.

Par contre je voudrais que la marco se loop toute seule sur toutes les lignes du tableau sinon, elle n'a aucun intérêt pour moi... (j'ai dans les 50 000 lignes au total... >< )

J'ai déjà fait pas mal de tentatives, mais débutant avec les vba, toutes se sont soldées par des échecs...

(pour des raisons évidentes, je ne pourrai pas mettre en ligne le classeur, celui-ci contenant des messages plus que privés...)

En espérant que vous pourrez m'aider !

Merci par avance !

à bientôt,

loubar

Bonjour,

essaie cette macro (à tester sur une copie de ton classeur !)

Sub test()
DL = Range("H" & Rows.Count).End(xlUp).Row
For i = 1 To DL
Range("E" & i & ":F" & i).UnMerge
Range("F" & i & ":G" & i).UnMerge
If Range("J" & 1) = "SNT" Then
    With Range("E" & i & ":F" & i)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .MergeCells = True
    End With
ElseIf Range("J" & 1) = "RCV" Then
    With Range("F" & i & ":G" & i)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .MergeCells = True
    End With
End If
Next i
End Sub

h2so4 a écrit :

Bonjour,

essaie cette macro (à tester sur une copie de ton classeur !)

Sub test()
DL = Range("H" & Rows.Count).End(xlUp).Row
For i = 1 To DL
Range("E" & i & ":F" & i).UnMerge
Range("F" & i & ":G" & i).UnMerge
If Range("J" & 1) = "SNT" Then
    With Range("E" & i & ":F" & i)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .MergeCells = True
    End With
ElseIf Range("J" & 1) = "RCV" Then
    With Range("F" & i & ":G" & i)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .MergeCells = True
    End With
End If
Next i
End Sub

Alors, au premier essai, ça marchait pas vraiment...

Du coup j'ai regardé un peu et J'ai juste modifié le :

If Range("J" & 1) = "SNT" Then

Par :

If Range("J" & i) = "SNT" Then

idem pour le "Elself Range"

Et du coup tout fonctionne parfaitement !

Un grand merci à toi ! tu m’enlèves une bonne épine du pieds !!

Petite question subsidiaire, maintenant que tout a été fusionné, mes hauteur de lignes ont disparue et sont toutes passées en lignes standard...

Y aurait il un moyen de mettre un coup d'ajustement auto de la hauteur des lignes malgré le fait qu'elles soient fusionnées ?

Merci beaucoup !

loubar

bonjour,

bien vu les corrections, erreur de copier coller, j'ai ajouté l'autofit.

Sub test()
dl = Range("H" & Rows.Count).End(xlUp).Row
For i = 1 To dl
Range("E" & i & ":F" & i).UnMerge
Range("F" & i & ":G" & i).UnMerge
If Range("J" & i) = "SNT" Then
    With Range("E" & i & ":F" & i)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .MergeCells = True
    End With
ElseIf Range("J" & i) = "RCV" Then
    With Range("F" & i & ":G" & i)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .MergeCells = True
    End With
End If
Next i
Rows("1:" & dl).AutoFit
End Sub

Pas de soucis

Par contre l'autofit n'a pas d'effet

bonjour,

peux-tu envoyer un extrait de ton fichier ?

h2so4 a écrit :

bonjour,

peux-tu envoyer un extrait de ton fichier ?

Je te joins 10 lignes avec du lorem en contenu

L'idée et donc d'avoir le système de fusion conditionnelle, si possible la hauteur de ligne auto et aussi (mais ça je sais comment le faire à la limite) insérer une ligne vide entre chaque ligne...

Merci beaucoup pour ton aide !

loubar

Bonjour,

apparemment l'autofit et les cellules fusionnées ne font pas bon ménage, j'ai essayé autre chose. à toi de voir si ça convient.

Sub test()
Application.ScreenUpdating = False
dl = Range("H" & Rows.Count).End(xlUp).Row
For i = dl To 1 Step -1
hauteur = Rows(i).RowHeight
Range("E" & i & ":F" & i).UnMerge
Range("F" & i & ":G" & i).UnMerge
If Range("J" & i) = "SNT" Then
    With Range("E" & i & ":F" & i)
        .WrapText = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .MergeCells = True

    End With
ElseIf Range("J" & i) = "RCV" Then
    With Range("F" & i & ":G" & i)
        .WrapText = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .MergeCells = True

    End With
End If
Rows(i & ":" & i).RowHeight = hauteur
If i > 1 Then
 Rows(i).Insert shift:=xlDown
 Rows(i).AutoFit
End If
Next i
Application.ScreenUpdating = True
End Sub

Ho ! miracle ! Merci merci merci merci merci !!!

C'est parfait

Un très grand merci à toi !

à bientôt

loubar