Réservation places loto

nike780

XLDnaute Junior
Bonjour,

On m'a fait parvenir un fichier pour la réservation des places pour un loto mais à chaque fois que je rentre une valeur il y a des messages d'erreur VBA, quelqu'un pourrait-il m'aider à résoudre ce problème.

Merci d'avance de votre réponse

Cdlt

Michel
 

Fichiers joints

camarchepas

XLDnaute Barbatruc
Re : Réservation places loto

Bonjour ,

A la lecture de la macro , un If est isolé et orphelin , je l'ai donc mis en commentaire . (En vert)

Comme je ne sais pas trop comment fonctionne le fichier pas pu faire de tests .

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B20:C150")) Is Nothing Then
Range("f3:ai16").ClearContents
For Each cellule In Range("F20:AI150")


        ligne = Asc(Left(cellule, 1)) - 62
        colonne = 5 + Right(cellule, Len(cellule) - 1) * 1
        Cells(ligne, colonne) = "X"
'If
Next cellule
End If
End Sub
 

nike780

XLDnaute Junior
Re : Réservation places loto

Bonjour,

Merci de votre réponse, normalement je ne devais utiliser que la première feuille mais comme cela ne fonctionne pas correctement, j'ai créé la 2ème.
Sur la première feuille, dans la colonne de gauche j'indique le nom et prénom et dans les 2 colonnes suivantes j'indique l'emplacement (ex L22- L24) le programme devrait mettre des croix dans la partie haute Rangée L et Place 22 et 23.

Mais comme vous pouvez le remarquer il y a un petit bug.

Cdlt

Michel
 

camarchepas

XLDnaute Barbatruc
Re : Réservation places loto

Re ,

J'ai modifié le code ainsi que la logique .

Je crois que comme ceci le fonctionnement est plus naturel .


Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LigneFin As Long, inter As String

If Not Intersect(Target, Range("B20:C150")) Is Nothing Then
  Application.EnableEvents = False
  Range("f3:ai16").ClearContents
  LigneFin = Range("A" & Rows.Count).End(xlUp).Row
  For Each cellule In Range("A20:A" & LigneFin)
    If cellule.Offset(0, 1) <> "" Then
      ligne = Range(cellule.Offset(0, 1)).Row
      colonne = Range(cellule.Offset(0, 1)).Column
      Cells(colonne, ligne).Offset(2, 5) = "X"
    End If
    If cellule.Offset(0, 2) <> "" Then
      ligne = Range(cellule.Offset(0, 2)).Row
      colonne = Range(cellule.Offset(0, 2)).Column
      Cells(colonne, ligne).Offset(2, 5) = "X"
    End If
  Next cellule
  Application.EnableEvents = True
End If
End Sub
 

Fichiers joints

nike780

XLDnaute Junior
Re : Réservation places loto

Re-Bonjour

Merci pour la modification mais je me suis mal exprimé dans ma demande en effet si l'on ne veut qu'une place on ne renseigne qu'une valeur mais au dela il faudrait que la macro mette des croix dans toutes les valeurs comprises entre les 2 valeurs (ex A1 - A5 = X de A1 à A5).

Si ce n'est pas possible tant pis pour moi.

Merci quand même d'avoir essayé.

Cdlt

Michel
 

nike780

XLDnaute Junior
Re : Réservation places loto

Re

Je viens de m'apercevoir que vous habitez Carrières sous Poissy, j'y ai habité rue de la Chapelle de 2002 à 2007
Cdlt

Michel
 

camarchepas

XLDnaute Barbatruc
Re : Réservation places loto

Et oui comme quoi le monde est petit ,

Pour les valeurs , j'ai suivi l'exemple , mais y'a moyen , il suffit de me donner la syntaxe d'encodage dans les 2 colonnes en question .

dans le cas de A1 à A5 , l'on aurait A1 en premiére colonne et A5 en 2eme , c'est cela ?
 

nike780

XLDnaute Junior
Re : Réservation places loto

Oui c'est bien cela dans la partie gauche je renseigne le nom prénom puis dans la valeur 1, j'indique la 1ère place à prendre et dans valeur 2, la dernière (ex Pajot D5 - D9), et dans le tableau du haut je voudrai voir des X dans les cases de D5 à D9.

Michel
 

camarchepas

XLDnaute Barbatruc
Re : Réservation places loto

Ok Michel,

Bon je crois que c'est ok , le seul soucci qui me reste c'est si tu réserve de l10 à M2 par exemple.

Mais cela ce produit-il ? au pire il faut créer 2 ligne pour la personne .....

Code:
Private Sub test() 'Worksheet_Change(ByVal Target As Range)
Dim LigneFin As Long, inter As String
Dim Adresse1 As String, Adresse2 As String
Dim Cellule As Range, Zone As Range

'If Not Intersect(Target, Range("B20:C150")) Is Nothing Then
  Application.EnableEvents = False
  Range("f3:ai16").ClearContents
  LigneFin = Range("A" & Rows.Count).End(xlUp).Row
  For Each Cellule In Range("A20:A" & LigneFin)
    If Cellule.Offset(0, 1) <> "" Then Adresse1 = Range(Cellule.Offset(0, 1)).Address

    If Cellule.Offset(0, 2) <> "" Then Adresse2 = Range(Cellule.Offset(0, 2)).Address
     For Each Zone In Range(Adresse1 & ":" & Adresse2).Cells
     Cells(Zone.Column + 2, Zone.Row + 5) = "X"
     Next
  Next Cellule
  Application.EnableEvents = True
'End If
End Sub
 
Dernière édition:

nike780

XLDnaute Junior
Re : Réservation places loto

Bonjour,

merci d'avance, pour ta question au cas ou il n'y aurait pas assez de place sur une rangée, je créerai une 2ème ligne. J'ai voulu tester ta formule en la copiant dans le fichier mais cela ne fonctionne pas, je pense qu'elle est encore en phase de test puisque en haut il y a "Private Sub Test (), ou alors je la copie mal dans ton précédent fichier.

En attendant ta réponse encore un grand merci.

Cdlt

Michel
 

Discussions similaires


Haut Bas