Renvoyer un message si deux cellules sélectionnées ne sont pas dans les colonnes voulues.

[francha62]

Bonjour à tous,

j'utilise une macro pour permuter deux cellules dans mes listes (On sélectionne les deux cellules et on clique sur le bouton qui active la macro pour permuter les cellules).

Cette macro (que j'ai récupérée sur internet) fonctionne très bien mais j'aimerai pouvoir faire en sorte qu'elle renvoie un message d'erreur si les deux cellules sélectionnées n'appartiennent pas à 2 (quelles qu'elles soient) des 8 colonnes (non contiguës) dans lesquelles se trouvent les données à permuter.

Je n'arrive pas du tout à créer un code le permettant. Je n'arrive notamment pas à comprendre comment nommer le fait qu'une sélection de deux cellules répondent à ces conditions.

Du coup si quelqu'un pouvait m'aider ce serait top !

Sub Swap()
'
'
    If Selection.Count <> 2 Then
         MsgBox "Ne sélectionner que 2 cellules à permuter"
         Exit Sub
    End If
    Set trange = Selection
    If trange.Areas.Count = 2 Then
         temp = trange.Areas(2)
         trange.Areas(2) = trange.Areas(1)
         trange.Areas(1) = temp
    Else
         temp = trange(1)
         trange(1) = trange(2)
         trange(2) = temp
    End If
End Sub

Merci d'avance !

 

[patricktoulon]

re
bonjour
déjà il faudrait faire la différence entre permuter deux colonnes et permuter les valeurs de deux colonnes
dans ton exemple tu permutes les valeurs et non les colonnes
ca a son importance en cas de formules 😉

 

[francha62]

Ah oui vous avez raison :

Il s'agit de permuter les valeurs de deux cellules situées dans deux colonnes différentes.

 

[patricktoulon]

sert toi de intersect pour contrôler si les colonne sont la ou tu veux qu'elles soient

 

[francha62]

On m'a proposé ceci et ça marche très bien :

 Sub Swap()
'
colonnes = Array(5, 8, 9, 10, 15, 17, 18, 24)
    If Selection.Count <> 2 Then
        MsgBox "Ne sélectionner que 2 cellules à permuter"
        Exit Sub
    End If

    Set trange = Selection
    If trange.Areas.Count = 2 Then
        If in_array(colonnes, trange.Areas(1).Column) And in_array(colonnes, trange.Areas(2).Column) Then
            temp = trange.Areas(2)
            trange.Areas(2) = trange.Areas(1)
            trange.Areas(1) = temp
        Else
            GoTo fin
        End If
    Else
        If in_array(colonnes, trange(1).Column) And in_array(colonnes, trange(2).Column) Then
            temp = trange(1)
            trange(1) = trange(2)
            trange(2) = temp
        Else
            GoTo fin
        End If
    End If
    Exit Sub
fin:
    MsgBox "Zone interdite !"
End Sub

Function in_array(tableau, recherche)
    'https://www.excel-pratique.com/fr/astuces_vba/recherche-tableau-array
    in_array = False
    For i = LBound(tableau) To UBound(tableau)
        If tableau(i) = recherche Then 'Si valeur trouvée
            in_array = True
            Exit For
        End If
    Next
End Function