Tests sur cellules fusionnées

[Toug]

Bonjour,
Je souhaiterais faire des tests sur le contenu de cellules fusionnées de tailles variables:

Dans ma macro je recherche des titres de Parties. Il y a 4 parties différentes. Chaque partie a des sous partie avec des statut "En Cours ou Clos". Je voudrais faire un statut général pour chaque partie en fct des statut qu'elle contient

J'arrive à trouver ces parties (à trouvers ou elles commencent et ou elles se termines)
J'arrive à faire un test sur la première référence de la cellule fusionnée, mais aprés je sais pas comment faire.
En gros si les cellules A8 à A14 sont fusionnées, le test fonctionne que sur la cellule A8.
Mon idée était de faire le test sur toutes les lignes de chaque partie, mais ça ne fonctionne pas.

 

[david84]

Re : Tests sur cellules fusionnées

Bonjour,

En gros si les cellules A8 à A14 sont fusionnées, le test fonctionne que sur la cellule A8.

c'est normal puisque tu as fusionné tes cellules.
Il te faut donc au début de ta macro dé-fusionner tes cellules et les fusionner à nouveau à la fin en utilisant les méthodes Merge et Unmerge de l'objet Range.
Si tu ne connais pas le VBA, le plus simple est de le faire avec l'enregistreur de macro afin d'avoir un code que tu pourras exploiter par la suite
A+

 

[eriiic]

Re : Tests sur cellules fusionnées

Bonjour,

Comme quoi les fusions de cellules sont bien à éviter au maximum... ;-)
Avec une fonction person,alisée par exemple :

Function statut(cell As Range) As String
    statut = Range(Split(cell.MergeArea.Address, ":")(0)).Value
End Function
Sub test()
    test = statut([A11])
End Sub

eric

 

[kjin]

Re : Tests sur cellules fusionnées

Bonjour,
Pas sûr d'avoir compris

Sub camembert()
i = 7
Do
    If Cells(i, 1) Like "Partie*" Then
    t = t & Cells(i, 1) & " contient: " & vbCrLf
    i = i + 1
    j = 1
        Do While Cells(i, 1).MergeCells
            t = t & vbTab & "sous-partie" & j & ": " & Cells(i, 1) & vbCrLf
            i = i + Cells(i, 1).MergeArea.Rows.Count
            j = j + 1
        Loop
    End If
Loop Until Cells(i, 1) = ""
MsgBox t
End Sub

A+
kjin