Savoir si 2 cellules sélectionnées appartiennent à une plage

Bonjour à tous,

c'est mon premier post. J'ai l'habitude de fouiner ça et là pour trouver des bouts de codes qui m'ont permis de gérer des tournois sportifs par exemple ou autre mais là je bloque!!!

Actuellement, la macro "bb" me permet de limiter la sélection du nombre de cellules à 2 et vérifier seulement si la cellule active (la deuxième sélectionnée) appartient à la plage pour ensuite intervertir les 2 cellules.

Or, je souhaiterais que cette macro intervertisse les 2 cellules sélectionnées si elle appartiennent toutes les 2 à une même plage.

Sub bb()

If Selection.Cells.Count <> 2 Then

MsgBox "veuillez sélectionner 2 équipes"

Else

Set maplage1 = Range("mesplages")

Set maplage2 = Selection.Cells

If Application.Intersect(maplage1, maplage2) Is Nothing Then

MsgBox "veuillez sélectionner 2 équipes"

Else

Dim cval(), cadd()

a = 1

ReDim cval(2), cadd(2)

For Each usrcell In Selection

cval(a) = usrcell.Value

cadd(a) = usrcell.Address

a = a + 1

Next usrcell

Range(cadd(1)).Select

ActiveCell = cval(2)

Range(cadd(2)).Select

ActiveCell = cval(1)

End If

End If

End Sub

Merci d'avance pour votre aide.

Bonjour et bienvenu(e)

Après test la macro fait ce que tu veux

Une autre manière (ta version un peu simplifié)

Sub bb()
  If Selection.Cells.Count <> 2 Then
    MsgBox "veuillez sélectionner 2 équipes"
  Else
    Set maplage1 = Range("mesplages")
    Set maplage2 = Selection.Cells

    If Application.Intersect(maplage1, maplage2) Is Nothing Then
      MsgBox "veuillez sélectionner 2 équipes"
    Else

      Dim cval(1), cadd(1)
      For Each usrcell In Selection
        cval(a) = usrcell.Value
        cadd(a) = usrcell.Address
        a = a + 1
      Next usrcell
      Range(cadd(0)) = cval(1)
      Range(cadd(1)) = cval(0)
    End If
  End If
End Sub

Bonjour,

merci pour la proposition. Je joins un fichier pour exposer mon problème. Il se compose d'un tableau avec des colonnes"N° Equipe" et "N° Table". Il s'agit d'un tirage pour un concours de jeu de cartes. Les équipes à droite et à gauche du n° de table doivent s'affronter. Or, si elle se sont déjà opposées, je souhaite en sélectionnant 1 puis une autre équipe et les intervertir. Par sécurité, je voudrais limiter la sélection à 2 cellules sélectionnées et à une plage déterminée pour éviter d'intervertir une équipe avec un N° de table par exemple ou une autre cellule non concernée.

Mais avec la macro actuelle on peut quand même faire cette erreur.

J'espère que c'est assez clair?

A bientôt.

9intervertir.xlsx (16.76 Ko)

Bonjour

A tester

Sub bb()
Dim Cel As Range

  If Selection.Cells.Count <> 2 Then
    MsgBox "veuillez sélectionner 2 équipes"
  Else
    Set maplage1 = Range("mesplages")
    Set maplage2 = Selection.Cells

    For Each Cel In maplage2
      If Application.Intersect(maplage1, Cel) Is Nothing Then
        MsgBox "veuillez sélectionner 2 équipes"
        Exit Sub
      End If
    Next Cel

    Dim cval(1), cadd(1)
    For Each usrcell In Selection
      cval(a) = usrcell.Value
      cadd(a) = usrcell.Address
      a = a + 1
    Next usrcell
    Range(cadd(0)) = cval(1)
    Range(cadd(1)) = cval(0)
  End If
End Sub

Merci Banzaï 64, la macro fonctionne. Sans vouloir abuser, peux-tu me l'expliquer sommairement? En effet, je comprends les grandes lignes du vba mais je ne fais que prendre des bouts de code ça et là, et je tente de les imbriquer pour arriver à mes fins. Jusqu'à maintenant c'était suffisant, mais ça faisait trop longtemps que je butais sur ce problème.

Merci encore et à bientôt!

Bonjour

A lire

Sub bb()
Dim Cel As Range, MaPlage1 As Range, MaPlage2 As Range
Dim UsrCell As Range, A As Integer

  If Selection.Cells.Count <> 2 Then          ' Si plus de 2 cellules séléctionnées
    MsgBox "veuillez sélectionner 2 équipes"  ' Message d'erreur
  Else
    Set MaPlage1 = Range("mesplages")         ' Initialisation des variables
    Set MaPlage2 = Selection.Cells            ' pour manipuler plus facilement les zones

    For Each Cel In MaPlage2                  ' Pour chaque cellule de la sélection
      If Application.Intersect(MaPlage1, Cel) Is Nothing Then ' Fait-elle partie de la bonne zone
        MsgBox "veuillez sélectionner 2 équipes"  ' Non alors message d'erreur
        Exit Sub                                  ' Et on sort de la macro
      End If
    Next Cel

    Dim Cval(1), Cadd(1)                      ' Déclaration de 2 tableaux de 2 éléments (0 et 1)
    For Each UsrCell In Selection             ' Pour chaque cellule de la sélection
      Cval(A) = UsrCell.Value                 ' 1er tableau on y note la valeur
      Cadd(A) = UsrCell.Address               ' 2éme tableau on y note l'adresse
      A = A + 1                               ' On se positionne sur le prochain élément des tableaux
    Next UsrCell
    Range(Cadd(0)) = Cval(1)                  ' Dans l'adresse de la 1ère valeur on y place la valeur de la 2ème adresse
    Range(Cadd(1)) = Cval(0)                  ' Dans l'adresse de la 2ème valeur on y place la valeur de la 1ère adresse
  End If
End Sub

Bonjour Banzaï64,

je n'ai pu répondre plus rapidement car je suis coupé du monde depuis 3 jours, réseau sfr à genou dans une partie de mon département. Je te remercie pour les explications claires et ta réactivité. Mon problème étant réglé, comment mettre la mention"résolu" sur ce sujet?

Bonjour

Regarde ma signature et cherche dans un tes messages la marque et ..... clic

Merci et à bientôt!

Rechercher des sujets similaires à "savoir selectionnees appartiennent plage"