Relier des nombres (dans un tableau)

[JJ1]

Bonsoir à tous,

Je modifie le message précédent car j'ai tracé à la règle 5 pentes et elle ne varient que très peu, donc je ne peux pas croiser ce résultat avec mon précédent tableau de progression. Dommage.
J'ai donc modifié le titre, car je souhaiterais relier tous les points identiques dans tout le tableau (G1 : DZ154) ce qui me permettrait de supprimer ce quadrillage très laid. Est-ce possible, toujours dans un tableau?
je joins un exemple pour le 1.(avec le nouveau fichier exemple)
Ne pas tenir compte du ficher Cla5-merci
Merci à vous et excellente soirée.

 

[JJ1]

Re : Relier des nombres (dans un tableau)

Bonjour à tous,

Problème résolu à la règle et au crayon, je n'avais besoin que d'un seul exemplaire.
Donc résolu.
Merci
Bonne journée

 

[Minick]

Re : Relier des nombres (dans un tableau)

Salut,

Juste pour le plaisir:

Option Explicit

Sub Scan()
    Dim Zone As Range, Cellule As Range
    Dim ValOk As String
    Dim Ligne As Integer, Colonne As Integer
    
    
    Application.ScreenUpdating = False
        Set Zone = Feuil1.Range("G1:DZ154")
        ValOk = ";"
        
        Call EffacerConnecteur(Zone.Parent)
        
        For Colonne = 1 To Zone.Columns.Count - 1
            For Ligne = 1 To Zone.Rows.Count - 1
                Zone.Cells(Ligne, Colonne).Select
                If Zone.Cells(Ligne, Colonne).Value <> "" Then
                    If InStr(1, ValOk, ";" & Zone.Cells(Ligne, Colonne).Value & ";") = 0 Then
                        Call Tracer(Zone.Offset(, Colonne - 1).Resize(, Zone.Columns.Count - Colonne + 1), Zone.Cells(Ligne, Colonne).Value)
                        ValOk = ValOk & Zone.Cells(Ligne, Colonne).Value & ";"
                    End If
                End If
            Next
        Next
    Application.ScreenUpdating = True
End Sub

Sub Tracer(ZoneTravail As Range, Valeur As String)
    Dim Rech As Range
    Dim Origine As String, Dernier As String
    Dim Connecteur As Shape
    Dim Feuille As Worksheet
    Dim CptValeur As Integer
    
    Set Feuille = ZoneTravail.Parent
    Set Rech = ZoneTravail.Find(what:=Valeur, after:=ZoneTravail.SpecialCells(xlCellTypeLastCell), LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext)
    
    If Not Rech Is Nothing Then
        Origine = Rech.Address
        Dernier = Rech.Address
        
        Do
            If Dernier <> Rech.Address Then
                CptValeur = CptValeur + 1
                Set Connecteur = Feuille.Shapes.AddConnector(msoConnectorStraight, Feuille.Range(Dernier).Left + Rech.Width, Feuille.Range(Dernier).Top + Rech.Height / 2, Rech.Left - Feuille.Range(Dernier).Left - Rech.Width, Rech.Top - Feuille.Range(Dernier).Top)
                Connecteur.Name = "Auto_Trace_" & Valeur & "_" & CptValeur
                Connecteur.Line.ForeColor.SchemeColor = 16
            End If
            Dernier = Rech.Address
            Set Rech = ZoneTravail.FindNext(Rech)
        Loop While Not Rech Is Nothing And Rech.Address <> Origine
    End If
End Sub

Sub EffacerConnecteur(Feuille As Worksheet)
    Dim Connecteur As Shape
    
    For Each Connecteur In Feuille.Shapes
        If LCase(Left(Connecteur.Name, 11)) = "auto_trace_" Then
            Connecteur.Delete
        End If
    Next
End Sub