IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

algorithme ou matrice pour déterminer des cellules entre deux cellules formant une plage [Toutes versions]


Sujet :

Macros et VBA Excel

  1. #1
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Points : 12 068
    Points
    12 068
    Billets dans le blog
    8
    Par défaut algorithme ou matrice pour déterminer des cellules entre deux cellules formant une plage
    Bonjour a tous

    J'essaie de trouver depuis deux jours le moyen de déterminer une plage de cellules correspondantes au cellules se trouvant sur la diagonale au plus près bien sur d'un rectangle formé par une plage
    exemple: ma plage va de a1 a f10
    les cellules seront a1,b2,c3,d4,e5,f6,f7,f8,f9,f10 avec les 5 dernieres sur la meme colonne cela etant la seule possibilité

    je voudrais aussi que ca face l'inverse f10 a a1 le resultat etant a l'envers

    quelqu'un a une idée

    merci pour le retour

    Au plaisir

  2. #2
    Membre actif
    Homme Profil pro
    Technicien Méthodes
    Inscrit en
    Mars 2013
    Messages
    128
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 36
    Localisation : France

    Informations professionnelles :
    Activité : Technicien Méthodes
    Secteur : Aéronautique - Marine - Espace - Armement

    Informations forums :
    Inscription : Mars 2013
    Messages : 128
    Points : 269
    Points
    269
    Par défaut
    Bonjour,

    Juste pour etre sur, quand tu dis

    je voudrais aussi que ca face l'inverse f10 a a1 le resultat etant a l'envers
    ca veut dire que le resultat sera

    f10, e9, d8, c7, b6 et de a5 à a1 ?

  3. #3
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Points : 12 068
    Points
    12 068
    Billets dans le blog
    8
    Par défaut re
    Bonjour Guiiand

    Oui c'est exactement ca

    Merci pour le retour

    Au plaisir

  4. #4
    Membre expert
    Homme Profil pro
    Retraité
    Inscrit en
    Avril 2011
    Messages
    1 858
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Retraité

    Informations forums :
    Inscription : Avril 2011
    Messages : 1 858
    Points : 3 974
    Points
    3 974
    Par défaut
    Bonjour Patrick,

    Une idée comme une autre
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    Sub Aller()
    Dim Debut As Range, Fin As Range
    Dim Ligfin, ColFin
        Set Debut = Range("A1")
        Set Fin = Range("F10")
     
        Ligfin = Fin.Row
        ColFin = Fin.Column
     
        Debut.Select
        Do Until Selection.Row = Ligfin And Selection.Column = ColFin
            Selection.Interior.ColorIndex = 6
            If Selection.Row < Rows.Count Then
                Selection.Offset(1, 0).Select
                If Selection.Row > Ligfin Then Selection.Offset(-1, 0).Select
            End If
            If Selection.Column < Columns.Count Then
                Selection.Offset(0, 1).Select
                If Selection.Column > ColFin Then Selection.Offset(0, -1).Select
            End If
        Loop
        Selection.Interior.ColorIndex = 6
    End Sub
    Sub Retour()
    Dim Debut As Range, Fin As Range
    Dim Ligdeb, ColDeb
        Set Debut = Range("A1")
        Set Fin = Range("F10")
     
        Ligdeb = Debut.Row
        ColDeb = Debut.Column
     
        Fin.Select
        Do Until Selection.Row = Ligdeb And Selection.Column = ColDeb
            Selection.Interior.ColorIndex = 3
            If Selection.Row > 1 Then
                Selection.Offset(-1, 0).Select
                If Selection.Row < Ligdeb Then Selection.Offset(1, 0).Select
            End If
            If Selection.Column > 1 Then
                Selection.Offset(0, -1).Select
                If Selection.Column < ColDeb Then Selection.Offset(0, 1).Select
            End If
        Loop
        Selection.Interior.ColorIndex = 3
    End Sub
    Fichiers attachés Fichiers attachés

  5. #5
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Points : 12 068
    Points
    12 068
    Billets dans le blog
    8
    Par défaut re
    Bonjour gFZT82
    tout d'abord merci pour le retour

    Je viens de l'essayer ca ne fonctionne pas dans tout les sens
    De plus je n'aime pas trop les selects

    Je préférerais obtenir un tableau d'adresse de cellules


    Je cherche cherche toujours

    Au plaisir

  6. #6
    Membre éprouvé
    Profil pro
    Inscrit en
    Juin 2009
    Messages
    652
    Détails du profil
    Informations personnelles :
    Localisation : France, Paris (Île de France)

    Informations forums :
    Inscription : Juin 2009
    Messages : 652
    Points : 1 219
    Points
    1 219
    Par défaut
    Bonjour,

    Une piste avec le code suivant.
    La manière que j'ai programmée nécessite de sélectionner d'abord une plage quelconque. Mais on peut changer cette façon de faire et passer une variable Range en paramètre ou coder le Range en dur ; à vous de voir et d'adapter le code à votre gré.
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    Sub DiagonaleInverse()
    Dim Plage As Range
    Dim R As Range
    Dim C As Range
    Dim NbLig&
    Dim NbCol&
    Dim GdeDim&
    Dim PteDim&
    Dim i&
    '---
    If TypeName(Selection) <> "Range" Then Exit Sub
    Set Plage = Selection
    NbLig& = Plage.Rows.Count
    NbCol& = Plage.Columns.Count
    '---
    PteDim& = NbLig&    'par défaut
    GdeDim& = NbCol&    'par défaut
    If PteDim& > NbCol& Then
      PteDim& = NbCol&
      GdeDim& = NbLig&
    End If
    '---
    For i& = GdeDim& To 1 Step -1
      If i& = GdeDim& Then
        Set C = Plage.Cells(Plage.Rows.Count, Plage.Columns.Count)
        Set R = C
      ElseIf i& > GdeDim& - PteDim& Then
        Set C = C.Offset(-1, -1)
        Set R = Application.Union(R, C)
      Else
        If NbLig& > NbCol& Then
          Set C = C.Offset(-1, 0)
        Else
          Set C = C.Offset(0, -1)
        End If
        Set R = Application.Union(R, C)
      End If
    Next i&
    '---
    MsgBox R.Address(False, False), , "Adresse"
    '--- pour visualiser le Range résultat ---
    R.Select
    End Sub
     
    Sub Diagonale()
    Dim Plage As Range
    Dim R As Range
    Dim C As Range
    Dim NbLig&
    Dim NbCol&
    Dim GdeDim&
    Dim PteDim&
    Dim i&
    '---
    If TypeName(Selection) <> "Range" Then Exit Sub
    Set Plage = Selection
    NbLig& = Plage.Rows.Count
    NbCol& = Plage.Columns.Count
    '---
    PteDim& = NbLig&    'par défaut
    GdeDim& = NbCol&    'par défaut
    If PteDim& > NbCol& Then
      PteDim& = NbCol&
      GdeDim& = NbLig&
    End If
    '---
    For i& = 1 To GdeDim&
      If i& = 1 Then
        Set C = Plage.Cells(1, 1)
        Set R = C
      ElseIf i& <= PteDim& Then
        Set C = C.Offset(1, 1)
        Set R = Application.Union(R, C)
      Else
        If NbLig& > NbCol& Then
          Set C = C.Offset(1, 0)
        Else
          Set C = C.Offset(0, 1)
        End If
        Set R = Application.Union(R, C)
      End If
    Next i&
    '---
    MsgBox R.Address(False, False), , "Adresse"
    '--- pour visualiser le Range résultat ---
    R.Select
    End Sub
    Si ce n'est pas indiscret, à quoi cela peut servir ?

  7. #7
    Membre chevronné
    Avatar de NVCfrm
    Homme Profil pro
    Administrateur Système/Réseaux - Developpeur - Consultant
    Inscrit en
    Décembre 2012
    Messages
    1 037
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations professionnelles :
    Activité : Administrateur Système/Réseaux - Developpeur - Consultant
    Secteur : High Tech - Produits et services télécom et Internet

    Informations forums :
    Inscription : Décembre 2012
    Messages : 1 037
    Points : 1 925
    Points
    1 925
    Billets dans le blog
    5
    Par défaut
    Bonsoir,

    Ceci pourra sans doute t'inspirer

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
     
        Dim curZone As Range, x As Range, md As Range, ri As Range, _
        nbArea As Integer, l As Integer
     
        Set md = Union(Range("a1"), Range("b2"), Range("c3"), Range("d4"), Range("e5"), Range("f6:f10"))
     
        Set curZone = Range("A1:F10")
     
        'simplement avec for each
        For Each x In md.Areas
            If x.Row > 5 Then
                For l = 1 To x.Rows.Count
     
                    Set ri = curZone.Range(Cells(6, 1), Cells(x.Row + l - 1, x.Column - 1)) 'juste la ligne
                    ri.Select
                    MsgBox "La selection actuelle a pour adresse " & ri.Address, vbInformation
                    'ou
                    Set ri = curZone.Range(Cells(x.Row, 1), Cells(x.Row, x.Column))   'au choix
                    ri.Select
                    MsgBox "La selection actuelle a pour adresse " & ri.Address, vbInformation
                Next
            Else
                Set ri = curZone.Range(Cells(x.Row + 1, 1), Cells(x.Row + 1, x.Column)) 'juste la ligne
                ri.Select
                MsgBox "La selection actuelle a pour adresse " & ri.Address, vbInformation
            End If
        Next

  8. #8
    Membre actif
    Profil pro
    Inscrit en
    Avril 2012
    Messages
    107
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Avril 2012
    Messages : 107
    Points : 265
    Points
    265
    Par défaut
    bon c'est un peu bourrin, tu devrais pouvoir l'arranger mais ça te donne un tableau d'adresse.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    Option Explicit
     
    Sub test()
     
        Dim rng As Range
        Dim Ws As Worksheet
        Dim rngRes As Range
        Dim c As Range
        Dim i As Integer
        Dim Adresses() As String
     
        Set Ws = ThisWorkbook.Worksheets("Feuil1")
        With Ws
            Set rng = .Range(.Cells(7, 12), .Cells(28, 77)) ' au choix
            Set rngRes = DiagRng(rng, True) ' false l'inverse
        End With
     
        ReDim Adresses(0 To rngRes.Cells.Count - 1)
        i = 0
        For Each c In rngRes
            Adresses(i) = c.Address
            i = i + 1
        Next c
     
     
    End Sub
     
     
    Function DiagRng(rng As Range, sens As Boolean) As Range
        Dim c As Range
        Dim x As Integer, y As Integer, w As Integer, h As Integer
        Dim b As Boolean
        Dim rngf As Range
        Dim Ws As Worksheet
     
        b = False
        Set Ws = rng.Worksheet
        For Each c In rng
            If b = False Then
                x = c.Column
                y = c.Row
                w = c.Column
                h = c.Row
                b = True
            Else
                If c.Column > w Then w = c.Column
                If c.Row > h Then h = c.Row
            End If
        Next c
     
        With Ws
            If sens = True Then
                Set DiagRng = .Cells(y, x)
                Do
                    If (x + 1) <= w Then x = x + 1
                    If (y + 1) <= h Then y = y + 1
     
                    Set DiagRng = Union(DiagRng, .Cells(y, x))
                Loop Until x = w And y = h
            Else
            Set DiagRng = .Cells(h, w)
                Do
                    If (w - 1) >= x Then w = w - 1
                    If (h - 1) >= y Then h = h - 1
     
                    Set DiagRng = Union(.Cells(h, w), DiagRng)
                Loop Until x = w And y = h
            End If
        End With
     
    End Function
    Si ce n'est pas indiscret, à quoi cela peut servir ?
    +1

  9. #9
    Membre actif
    Homme Profil pro
    Technicien Méthodes
    Inscrit en
    Mars 2013
    Messages
    128
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 36
    Localisation : France

    Informations professionnelles :
    Activité : Technicien Méthodes
    Secteur : Aéronautique - Marine - Espace - Armement

    Informations forums :
    Inscription : Mars 2013
    Messages : 128
    Points : 269
    Points
    269
    Par défaut
    Bonjour,

    Voici ma contribution

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    Sub Diag(HautGauche As Range, BasDroite As Range, Optional Origine As Integer = 1)
     
        Dim DLigne As Integer
        Dim DColonne As Integer
        Dim FLigne As Integer
        Dim FColonne As Integer
        Dim LMax As Integer
     
        Dim Lig As Integer
        Dim Col As Integer
     
        Dim NbLigne As Integer
        Dim NbColonne As Integer
     
        Dim TabAdress() As Range
     
        Select Case Origine
            Case 1 'Départ en haut a gauche, arrivée en bas à droite
                DLigne = HautGauche.Row
                DColonne = HautGauche.Column
                FLigne = BasDroite.Row
                FColonne = BasDroite.Column
            Case 2 'Départ en haut a droite, arrivée en bas à gauche
                DLigne = HautGauche.Row
                DColonne = BasDroite.Column
                FLigne = BasDroite.Row
                FColonne = HautGauche.Column
            Case 3 'Départ en bas a droite, arrivée en haut a gauche
                DLigne = BasDroite.Row
                DColonne = BasDroite.Column
                FLigne = HautGauche.Row
                FColonne = HautGauche.Column
            Case 4 'Départ en bas a gauche, arrivée en haut à droite
                DLigne = BasDroite.Row
                DColonne = HautGauche.Column
                FLigne = HautGauche.Row
                FColonne = BasDroite.Column
            Case Else
                MsgBox ("L'indice n'appartient pas à la sélection")
                Exit Sub
        End Select
     
        NbLigne = Abs(DLigne - FLigne)
        NbColonne = Abs(DColonne - FColonne)
     
        If NbLigne > NbColonne Then LMax = NbLigne Else LMax = NbColonne
     
        ReDim TabAdress(LMax)
     
        For i = 0 To LMax
            If i > NbLigne Then Lig = NbLigne Else Lig = i
            If i > NbColonne Then Col = NbColonne Else Col = i
            Select Case Origine
                Case 1
                    Set TabAdress(i) = Cells(DLigne + Lig, DColonne + Col)
                Case 2
                    Set TabAdress(i) = Cells(DLigne + Lig, DColonne - Col)
                Case 3
                    Set TabAdress(i) = Cells(DLigne - Lig, DColonne - Col)
                Case 4
                    Set TabAdress(i) = Cells(DLigne - Lig, DColonne + Col)
            End Select
            'Cells(TabAdress(i).Row, TabAdress(i).Column).Interior.ColorIndex = 6
        Next
     
    End Sub
     
    Sub test()
     
        Call Diag(Range("A1"), Range("F10"))
     
    End Sub
    De meme, un peu bourrin, mais ca marche.

    Je pourrais peut etre m'affranchir du sens que j'ai mis en optional en faisant des tests sur les adresse des cellules passées en paramètre.

  10. #10
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Points : 12 068
    Points
    12 068
    Billets dans le blog
    8
    Par défaut re
    Bonjour a tous

    Tout d'abord Merci a tous pour votre retour

    je n'avais pas tout vu

    Mais de mon coté j'ai bien planché sur la question

    Alors d'après ce que j'ai vu il y en certain plutôt efficace avec diverses méthodes

    mais je suis partisans de la réduction au maximum de code et bien sur des selects et activate ainsi que les boucles etc.... au maximum qui ralentissent l'exécution du code

    alors voila ma methode :
    Si on peu l'améliorer je ne suis pas contre
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
     
    Option Explicit
    Sub test1()
        trouve_le_chemin_le_plus_court [m3], [b18]
    End Sub
     
     
    Function trouve_le_chemin_le_plus_court(oldcel As Range, newcel As Range)
    ' Set oldcel = cellule de depart
    ' newcel = cellule de destination
        Dim i As Long
        Dim nblig As Long, nbcol As Long, col As Long, lig As Long
    Dim stepercol As Long, steperlig As Long
        With Sheets(1)
            .Cells.Interior.Color = xlNone
            nblig = .Range(oldcel, newcel).Rows.Count    'le nombre de colonnes que contient la plage formée par la oldcel et la newcel
            nbcol = .Range(oldcel, newcel).Columns.Count    ' le nombre de ligne ""      ""       ""   idem
            'selon si oldcel.column est plus petit que la newcel.column la variable stepercol sera negative ou positive
            stepercol = IIf(newcel.Column < oldcel.Column, -1, 1)
            ' et pareil pour la ligne
            steperlig = IIf(newcel.Row < oldcel.Row, -1, 1)
            col = oldcel.Column    'colonne de depart
            lig = oldcel.Row    'ligne de depart
            'si le nombre de colonnes de la plage formée par les deux cellules est plus grand  quele nombre de ligne
            If nbcol > nblig Then
                For i = 1 To nbcol
                    .Cells(lig, col).Interior.Color = vbRed
                    col = col + stepercol
                    lig = IIf(i >= nblig, newcel.Row, lig + steperlig)
                Next
                'si le nombre de colonnes de la plage formée par les deux cellules est plus petit  que le nombre de ligne
            ElseIf nbcol < nblig Then
                For i = 1 To nblig
                    .Cells(lig, col).Interior.Color = vbRed
                    lig = lig + steperlig
                    col = IIf(i >= nbcol, newcel.Column, col + stepercol)
                Next
            End If
        End With
    End Function
    Merci a tous pour le retour

    Au plaisir

  11. #11
    Expert éminent sénior Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Points : 31 877
    Points
    31 877
    Par défaut
    Bonjour à tous
    Ma proposition (la fonction Sgn m'est d'une grande utilité)

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    Private Sub Diago(ByVal Deb As Range, ByVal Fin As Range)
    Dim Cdif As Integer, Rdif As Integer
    Dim Res As Range
     
    With Deb.Parent
        .UsedRange.Interior.ColorIndex = xlNone
        Rdif = Sgn(Fin.Row - Deb.Row)
        Set Res = Deb
        Do
            Cdif = Sgn(Fin.Column - Deb.Column)
            Set Deb = Deb.Offset(Rdif, Cdif)
            Set Res = Union(Res, Deb)
        Loop Until Cdif = 0
        Set Res = Union(Res, .Range(Deb, Fin))
    End With
     
    Res.Interior.Color = 255
    Set Res = Nothing
    End Sub

  12. #12
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Points : 12 068
    Points
    12 068
    Billets dans le blog
    8
    Par défaut
    Bonsoir Mercatog
    WaOuuUu... Celle la elle me ,encore plus courte en terme de ligne de code que la mienne

    je vais l'analyser

    merci a toi
    edit
    ho op !!!pourquoi res.address me donne une erreur
    res est bien un range ?

    Au plaisir

    Re

    Après analyse elle est tres proche de mon principe
    tu utilise "sgn" pour le pas négatif ou positif
    moi j'utilise

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    stepercol = IIf(newcel.Column < oldcel.Column, -1, 1)
            ' et pareil pour la ligne
            steperlig = IIf(newcel.Row < oldcel.Row, -1, 1)
    Donc si j'ai bien compris le "res" est modifié a chaque boucle par le "union"en changeant le "deb"
    Est ce bien ca ??
    Au plaisir

  13. #13
    Expert éminent sénior Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Points : 31 877
    Points
    31 877
    Par défaut
    Oui c'est ça.
    Le but est de déplacer la cellule Deb jusqu'à ce qu'elle arrive à la colonne de Fin
    Le chemin parcouru est récupéré par la variable range Res

    (bien sûr la nombre de colonnes entre Deb et Fin devrait être inférieur au nombres de lignes entre Deb et Fin, vu le sujet initial. néanmoins, il faudra ajouter un petit test pour ne pas avoir du n'importe quoi)

    Le même code en évitant la boucle do et en utilisant une boucle For bien limitée à l'avance:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    Private Sub Diago(ByVal Deb As Range, ByVal Fin As Range)
    Dim Cdif As Integer, Rdif As Integer, i As Integer, n As Integer
    Dim Res As Range
     
    With Deb.Parent
        .UsedRange.Interior.ColorIndex = xlNone
        Rdif = Sgn(Fin.Row - Deb.Row)
        Cdif = Sgn(Fin.Column - Deb.Column)
     
        n = Abs(Fin.Column - Deb.Column)
        Set Res = .Range(Deb.Offset(Rdif * n, Cdif * n), Fin)
        For i = 0 To n - 1
            Set Res = Union(Res, Deb.Offset(Rdif * i, Cdif * i))
        Next i
    End With
    Res.Interior.Color = 255
    Set Res = Nothing
    End Sub
    Pour généraliser la chose, quelque soient les cas de figure
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    Private Sub DiagoGle(ByVal Deb As Range, ByVal Fin As Range)
    Dim Cdif As Integer, Rdif As Integer, i As Integer, n As Integer
    Dim Res As Range
     
    With Deb.Parent
        .UsedRange.Interior.ColorIndex = xlNone
        Rdif = Sgn(Fin.Row - Deb.Row)
        Cdif = Sgn(Fin.Column - Deb.Column)
     
        n = Application.Min(Abs(Fin.Row - Deb.Row), Abs(Fin.Column - Deb.Column))
        Set Res = .Range(Deb.Offset(Rdif * n, Cdif * n), Fin)
        For i = 0 To n - 1
            Set Res = Union(Res, Deb.Offset(Rdif * i, Cdif * i))
        Next i
    End With
    Res.Interior.Color = 255
    Set Res = Nothing
    End Sub

  14. #14
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Points : 12 068
    Points
    12 068
    Billets dans le blog
    8
    Par défaut re
    Bonjour Mercatog

    je suis encore sur ta 1 ere version en tout cas elle est nickel
    Laisse moi digérer la première

    Je n'ai pas testé la derniere mais j'ai un souci avec "res"depuis ta premiere version

    "res" est -elle la plage obtenue tour apres tour de la boucle ou la derniere cellule obtenue du dernier tour ???,car a chaque tour c'est cette cellule que je veux non pas le range de la diagonale
    J'ai du mal a savoir car res.address génère une erreur

    Merci pour le retour

    Au plaisir

  15. #15
    Expert éminent sénior Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Points : 31 877
    Points
    31 877
    Par défaut
    Bonjour Patrick

    Dans Res, tu obtiens l'union de toutes les cellules de la diagonale en plus des dernières cellules sur la dernière colonne (conformément à ton 1er poste dans Res on va obtenir l'union des cellules A1, B2...E5, F6, F7, F8...

    Dans mon code initial si le nombre de colonnes est supérieur au nombre de lignes (entre la cellule de départ et la cellule finale) tu 'auras n'importe quoi

    Exemple avec ce test
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    Sub test()
     
    Diago [A1], [F3]
    End Sub
    Ce même problème n'intervient pas avec mon dernier code

    Test
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    Sub test()
     
    DiagoGle [A1], [F3]
    End Sub

  16. #16
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Points : 12 068
    Points
    12 068
    Billets dans le blog
    8
    Par défaut
    Bonsoir Mercatog

    Merci pour le retour

    je vais analyser tout ca lundi car ce week end cheval en camarge


    Au plaisir

    Bonjour mercatog

    je viens de regarder la dernière "diagoGLe" en effet on y arrive en 1 seule boucle
    j'y ai pensé ce dimanche et en fait mise a part les fonctions "min et abs "utilisées,ca ressemble beaucoup a cette version

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
     
    Sub test4()
        Cells.Interior.Color = xlNone
        diago3 [d30], [l2]
    End Sub
    Function diago3(oldcel, newcel)
        couleur = Rnd * 15625456
        rowdiff = Sgn(newcel.Row - oldcel.Row)
        coldiff = Sgn(newcel.Column - oldcel.Column)
        nbcol = Range(oldcel, newcel).Columns.Count - 1
        nblig = Range(oldcel, newcel).Rows.Count
        res = oldcel
        Do
            oldcel.Offset(rowdiff * i, coldiff * e).Interior.Color = couleur
            i = IIf(i + 1 < nblig, i + 1, nblig)
            e = IIf(e + 1 < nbcol, e + 1, nbcol)
            DoEvents
        Loop Until e = nbcol And i = nblig
    End Function
    Finalement ce qui me parraissait compliqué au depart ne l'est pas du tout .
    Je vais analyser la "diagogle" a fin d'en comprendre ces deux fonctions"min et abs"

    Je te remercie pour le retour

    re
    J'ai un souci avec laligne "n=...."

    si je met un msgbox il m'affiche 11
    ok dans ton exemplaire c'est le nombre de colonnes

    Mais alors dans la boucle comment fait tu pour utiliser le meme "n" pour les colonnes et les lignes

    J'avoue que je comprend pas

    merci pour le retour

    Au plaisir

  17. #17
    Expert éminent sénior Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Points : 31 877
    Points
    31 877
    Par défaut
    Explication de ce code
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    Private Sub DiagoGle(ByVal Deb As Range, ByVal Fin As Range)
    Dim Cdif As Integer, Rdif As Integer, i As Integer, n As Integer
    Dim Res As Range
     
    With Deb.Parent
        .UsedRange.Interior.ColorIndex = xlNone
        Rdif = Sgn(Fin.Row - Deb.Row)
        Cdif = Sgn(Fin.Column - Deb.Column)
     
        n = Application.Min(Abs(Fin.Row - Deb.Row), Abs(Fin.Column - Deb.Column))
        Set Res = .Range(Deb.Offset(Rdif * n, Cdif * n), Fin)
        For i = 0 To n - 1
            Set Res = Union(Res, Deb.Offset(Rdif * i, Cdif * i))
        Next i
    End With
    Res.Interior.Color = 255
    Set Res = Nothing
    End Sub
    A l'aide de cet exemple
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    Sub test()
     
    DiagoGle [A1], [N11]
    End Sub
    On commence en A1 et on veux terminer en N11. Loffset donné par Rdif et Cdif est de +1. donc pour aller de A1 à N11, on fait à chaque boucle un offset de (+1,+1), càd A1-B2-C3....
    On est dans cet exemple en présence d'une plage de 11 lignes et 14 colonnes.
    Donc si on part en diagonal à partir de A1 sans dépasser la ligne 11 on va faire une boucle de n offset où n est le nombre de lignes entre la ligne de début et la ligne de fin -1 (l'offset commence de 0)

    (Remarque si la plage contient moins de colonnes que de lignes, le raisonnement se fera sur les colonnes et non les lignes)

    Pour la variable Res, on commence par le dernier pallier de la dernière ligne: ici K11:N11 (ou colonne) et on y "ajoute" les cellules de la diagonal de A1 à J10

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [XL-2000] VBA pour sommer des valeures entre deux dates (nombreuses données)
    Par maxhor dans le forum Macros et VBA Excel
    Réponses: 5
    Dernier message: 11/04/2014, 17h30
  2. Réponses: 4
    Dernier message: 04/12/2013, 10h08
  3. [XL-2010] Compter de cellules entre deux cellules variables
    Par steam-x dans le forum Macros et VBA Excel
    Réponses: 12
    Dernier message: 19/07/2013, 15h50
  4. Réponses: 1
    Dernier message: 12/05/2007, 15h29
  5. [win] problème pour partager des fichiers entre 2 pc
    Par goma771 dans le forum Administration
    Réponses: 1
    Dernier message: 01/12/2005, 16h15

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo