Savoir si 2 cellules sélectionnées appartiennent à une plage Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
b
bourbier
Nouveau venu
Nouveau venu
Messages : 7
Inscrit le : 30 novembre 2015
Version d'Excel : 2010

Message par bourbier » 2 décembre 2015, 16:15

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.
Avatar du membre
Banzai64
Fanatique d'Excel
Fanatique d'Excel
Messages : 16'726
Appréciations reçues : 2
Inscrit le : 21 novembre 2010
Version d'Excel : 2003 FR (learning 2010 - 2013)

Message par Banzai64 » 2 décembre 2015, 18:48

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
Image
b
bourbier
Nouveau venu
Nouveau venu
Messages : 7
Inscrit le : 30 novembre 2015
Version d'Excel : 2010

Message par bourbier » 3 décembre 2015, 11:58

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.
intervertir.xlsx
(16.76 Kio) Téléchargé 8 fois
Avatar du membre
Banzai64
Fanatique d'Excel
Fanatique d'Excel
Messages : 16'726
Appréciations reçues : 2
Inscrit le : 21 novembre 2010
Version d'Excel : 2003 FR (learning 2010 - 2013)

Message par Banzai64 » 3 décembre 2015, 13:41

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
Image
b
bourbier
Nouveau venu
Nouveau venu
Messages : 7
Inscrit le : 30 novembre 2015
Version d'Excel : 2010

Message par bourbier » 4 décembre 2015, 13:14

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!
Avatar du membre
Banzai64
Fanatique d'Excel
Fanatique d'Excel
Messages : 16'726
Appréciations reçues : 2
Inscrit le : 21 novembre 2010
Version d'Excel : 2003 FR (learning 2010 - 2013)

Message par Banzai64 » 4 décembre 2015, 13:39

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
Image
b
bourbier
Nouveau venu
Nouveau venu
Messages : 7
Inscrit le : 30 novembre 2015
Version d'Excel : 2010

Message par bourbier » 7 décembre 2015, 11:27

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?
Avatar du membre
Banzai64
Fanatique d'Excel
Fanatique d'Excel
Messages : 16'726
Appréciations reçues : 2
Inscrit le : 21 novembre 2010
Version d'Excel : 2003 FR (learning 2010 - 2013)

Message par Banzai64 » 7 décembre 2015, 14:33

Bonjour

Regarde ma signature et cherche dans un tes messages la marque et ..... clic
Image
b
bourbier
Nouveau venu
Nouveau venu
Messages : 7
Inscrit le : 30 novembre 2015
Version d'Excel : 2010

Message par bourbier » 7 décembre 2015, 15:02

Merci et à bientôt!
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message