Demande d'aide sous excel

Bonjour.
J'ai un tableau d'entreprises avec diverses infos et divers contacts pour chacunes.
Je veux passer de ça:
http://img157.imageshack.us/img157/722/schma1ws0.png
à ça:
http://img82.imageshack.us/img82/5571/schma2ep7.png

En gros il faudrait que lorsque qqchose est identique ds A,il y ait un encadré en gras jusqu'à B par exemple.

Merci de votre aide

9 réponses

  1. Bonjour,

    comme les mises en forme conditionnelles ne permettent pas d'encadrer en gras, je n'ai pas trouvé d'autres solutions que par macro.
    en voici le code :
    Sub Macro1()
        Set wzone = Selection.CurrentRegion
        wzone.Borders(xlDiagonalDown).LineStyle = xlNone
        wzone.Borders(xlDiagonalUp).LineStyle = xlNone
        With wzone.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With wzone.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With wzone.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With wzone.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With wzone.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With wzone.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        
        i = 1
        wzone(i, 1).Select
        While i <= wzone.Rows.Count
            Set zonedeb = wzone(i, 1)
            While wzone(i, 1) = wzone(i + 1, 1)
                i = i + 1
            Wend
            Range(zonedeb, wzone(i, 2)).Select
                Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlMedium
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlMedium
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlMedium
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlMedium
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            i = i + 1
        Wend
        Range("A1").Select
    End Sub
    avant de le lancer, sélectionne une cellule du tableau.

    cordialement
    0
    1. Merci JvDo.
      Petit problème erreur à cette ligne là:
      erreur 1004 impossible de définir la propriété linestyle de la classe border.Il me montre la ligne souligné ci dessous:

      With Selection.Borders(xlInsideHorizontal)
      .LineStyle = xlContinuous

      A la fin.
      Bon en même temps c'est la 1ère fois que je fais ça.J'ai fait:
      Outils/Macros/Visual basic editors
      Et dedans
      Insertion/Module/J'ai rentré le code/Refermé et lancé la macro ds le classeur concerné en ayant sélectionné la première case ou tte la première ligne.A chaque fois la même erreur.
      0
      1. Bonjour,

        oui, j'ai déjà eu cette erreur et je ne sais pas pourquoi.
        j'ai viré tout simplement le bloc with concerné.

        si c'est la même chose pour le insidevertical, supprime aussi!

        même pas peur!

        essaye

        A+
        0
        1. Ca marche!
          la vache!Génial merci
          Par contre comment faire pour rallonger le cadre.
          Quoi modifier pour encadrer de A à Q?
          0
          1. Bonjour,

            il faut remplacer le 2 dans Range(zonedeb, wzone(i, 2)).Select
            par wzone.Columns.Count

            soit au final Range(zonedeb, wzone(i, wzone.Columns.Count)).Select

            A+
            0
            1. Chapeau JvDo...
              Enorme!J'ai peut être une dizaine d'onglet avec bien 1500 lignes à chaque fois.
              Je le faisais à la main.La première fois ça m'a pris des heures.
              Là...
              Merci vraiment.Tu me retires une sacré épine du pied

              A+
              0
              1. J'en rajoute une couche mais c'est trop génial.
                Tu n'imagine même pas comme ça va me faciliter le travail.
                Merci JvDo
                0
                1. Bonjour,

                  tu peux même envisager de faire une boucle sur tes 10 onglets s'ils ont une cellule commune, ce qui doit être le cas avec autant de lignes.

                  A+
                  0
                  1. Contributeur
                    Salut

                    "les mises en forme conditionnelles ne permettent pas d'encadrer en gras"

                    Vrai, mais par contre, on peut encadrer en couleur et on peut colorer la cellule.
                    Mais ta solution est quand même pas mal.
                    0
                2. Bonjour,

                  j'ai trois colonnes la 1ère avec des numéros de tel qui reviennent souvent, la seconde intitulée : semaine et dans la troisième j'aimerais pouvoir faire figurer la fréquence de sortie de chaque numéro de tel par semaine ?? quelle formule dois-je entrer ?

                  merci pour toute l'aide que vous pourrez m'apporter.

                  Cordialement
                  0